ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

profiles: Do away with 'manifest=?'.

Browse source 
* 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 @@ (define-module (guix profiles)
manifest-remove manifest-remove
manifest-installed? manifest-installed?
manifest-matching-entries manifest-matching-entries
manifest=?
profile-manifest profile-manifest
profile-derivation profile-derivation
@ -196,13 +195,6 @@ (define (matches? entry)
(filter matches? (manifest-entries manifest))) (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. ;;; Profiles.

70
guix/scripts/package.scm
View file

@ -750,6 +750,16 @@ (define (maybe-register-gc-root store profile)
(unless (string=? profile %current-profile) (unless (string=? profile %current-profile)
(add-indirect-root store (canonicalize-path 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. ;;; Entry point.
@ -921,36 +931,40 @@ (define (delete-generation number)
(when (equal? profile %current-profile) (when (equal? profile %current-profile)
(ensure-default-profile)) (ensure-default-profile))
(if (manifest=? new manifest) (unless (and (null? install) (null? remove))
(format (current-error-port) (_ "nothing to be done~%")) (let* ((prof-drv (profile-derivation (%store) new))
(let ((prof-drv (profile-derivation (%store) new)) (prof (derivation->output-path prof-drv))
(remove (manifest-matching-entries manifest remove))) (remove (manifest-matching-entries manifest remove)))
(show-what-to-remove/install remove install dry-run?) (show-what-to-remove/install remove install dry-run?)
(show-what-to-build (%store) (list prof-drv) (show-what-to-build (%store) (list prof-drv)
#:use-substitutes? #:use-substitutes?
(assoc-ref opts 'substitutes?) (assoc-ref opts 'substitutes?)
#:dry-run? dry-run?) #:dry-run? dry-run?)
(or dry-run? (cond
(let* ((prof (derivation->output-path prof-drv)) (dry-run? #t)
(number (generation-number profile)) ((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, ;; Always use NUMBER + 1 for the new profile,
;; possibly overwriting a "previous future ;; possibly overwriting a "previous future
;; generation". ;; generation".
(name (generation-file-name profile (name (generation-file-name profile
(+ 1 number)))) (+ 1 number))))
(and (build-derivations (%store) (list prof-drv)) (and (build-derivations (%store) (list prof-drv))
(let ((count (length entries))) (let ((count (length entries)))
(switch-symlinks name prof) (switch-symlinks name prof)
(switch-symlinks profile name) (switch-symlinks profile name)
(maybe-register-gc-root (%store) profile) (maybe-register-gc-root (%store) profile)
(format #t (N_ "~a package in profile~%" (format #t (N_ "~a package in profile~%"
"~a packages in profile~%" "~a packages in profile~%"
count) count)
count) count)
(display-search-paths entries (display-search-paths entries
profile))))))))))) profile))))))))))))
(define (process-query opts) (define (process-query opts)
;; Process any query specified by OPTS. Return #t when a query was ;; Process any query specified by OPTS. Return #t when a query was