From 48704e5b5c9a18a3f381ec5a266d0375219ae122 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 26 Jul 2014 21:43:43 +0200
Subject: 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.
---
 guix/profiles.scm        |  8 ------
 guix/scripts/package.scm | 74 ++++++++++++++++++++++++++++--------------------
 2 files changed, 44 insertions(+), 38 deletions(-)

(limited to 'guix')

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
-- 
cgit v1.2.3