aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-07-26 21:43:43 +0200
committerLudovic Courtès <ludo@gnu.org>2014-07-26 22:56:59 +0200
commit48704e5b5c9a18a3f381ec5a266d0375219ae122 (patch)
tree93853c28c9fa5aca639d7ba1c55740dbfbc36e30
parentf280cdb1bafefee42d0c573ecabb0d9bd0659e64 (diff)
downloadpatches-48704e5b5c9a18a3f381ec5a266d0375219ae122.tar
patches-48704e5b5c9a18a3f381ec5a266d0375219ae122.tar.gz
profiles: Do away with 'manifest=?'.
* guix/profiles.scm (manifest=?): Remove. * guix/scripts/package.scm (readlink*): New procedure. (guix-package)[process-actions]: Use 'readlink*' and compare the profile to be built, PROF, with PROFILE to determine whether there's nothing to be done.
-rw-r--r--guix/profiles.scm8
-rw-r--r--guix/scripts/package.scm74
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