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

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.
This commit is contained in:
Ludovic Courtès 2014-07-26 21:43:43 +02:00
parent f280cdb1ba
commit 48704e5b5c
2 changed files with 42 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
guix/profiles.scm
View File

@ -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.

70
guix/scripts/package.scm
View File

@ -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?)
(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?)
(or dry-run?
(let* ((prof (derivation->output-path prof-drv))
(number (generation-number profile))
(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)))))))))))
;; 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