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-installed?
manifest-matching-entries
manifest=?
profile-manifest
profile-derivation
@ -196,13 +195,6 @@ (define (matches? entry)
(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 @@ (define (maybe-register-gc-root store profile)
(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 @@ (define (delete-generation number)
(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