guix package: Use 'manifest-transaction'.
* guix/scripts/package.scm (guix-package)[process-actions]: Use 'manifest-transaction' instead of the equivalent code. (show-what-to-remove/install): Remove. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
		
							parent
							
								
									343745c80a
								
							
						
					
					
						commit
						89caec6920
					
				
					 1 changed files with 11 additions and 52 deletions
				
			
		| 
						 | 
					@ -184,49 +184,6 @@ DURATION-RELATION with the current time."
 | 
				
			||||||
         filter-by-duration)
 | 
					         filter-by-duration)
 | 
				
			||||||
        (else #f)))
 | 
					        (else #f)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (show-what-to-remove/install remove install dry-run?)
 | 
					 | 
				
			||||||
  "Given the manifest entries listed in REMOVE and INSTALL, display the
 | 
					 | 
				
			||||||
packages that will/would be installed and removed."
 | 
					 | 
				
			||||||
  ;; TODO: Report upgrades more clearly.
 | 
					 | 
				
			||||||
  (match remove
 | 
					 | 
				
			||||||
    ((($ <manifest-entry> name version output path _) ..1)
 | 
					 | 
				
			||||||
     (let ((len    (length name))
 | 
					 | 
				
			||||||
           (remove (map (cut format #f "   ~a-~a\t~a\t~a" <> <> <> <>)
 | 
					 | 
				
			||||||
                        name version output path)))
 | 
					 | 
				
			||||||
       (if dry-run?
 | 
					 | 
				
			||||||
           (format (current-error-port)
 | 
					 | 
				
			||||||
                   (N_ "The following package would be removed:~%~{~a~%~}~%"
 | 
					 | 
				
			||||||
                       "The following packages would be removed:~%~{~a~%~}~%"
 | 
					 | 
				
			||||||
                       len)
 | 
					 | 
				
			||||||
                   remove)
 | 
					 | 
				
			||||||
           (format (current-error-port)
 | 
					 | 
				
			||||||
                   (N_ "The following package will be removed:~%~{~a~%~}~%"
 | 
					 | 
				
			||||||
                       "The following packages will be removed:~%~{~a~%~}~%"
 | 
					 | 
				
			||||||
                       len)
 | 
					 | 
				
			||||||
                   remove))))
 | 
					 | 
				
			||||||
    (_ #f))
 | 
					 | 
				
			||||||
  (match install
 | 
					 | 
				
			||||||
    ((($ <manifest-entry> name version output item _) ..1)
 | 
					 | 
				
			||||||
     (let ((len     (length name))
 | 
					 | 
				
			||||||
           (install (map (lambda (name version output item)
 | 
					 | 
				
			||||||
                           (format #f "   ~a-~a\t~a\t~a" name version output
 | 
					 | 
				
			||||||
                                   (if (package? item)
 | 
					 | 
				
			||||||
                                       (package-output (%store) item output)
 | 
					 | 
				
			||||||
                                       item)))
 | 
					 | 
				
			||||||
                         name version output item)))
 | 
					 | 
				
			||||||
       (if dry-run?
 | 
					 | 
				
			||||||
           (format (current-error-port)
 | 
					 | 
				
			||||||
                   (N_ "The following package would be installed:~%~{~a~%~}~%"
 | 
					 | 
				
			||||||
                       "The following packages would be installed:~%~{~a~%~}~%"
 | 
					 | 
				
			||||||
                       len)
 | 
					 | 
				
			||||||
                   install)
 | 
					 | 
				
			||||||
           (format (current-error-port)
 | 
					 | 
				
			||||||
                   (N_ "The following package will be installed:~%~{~a~%~}~%"
 | 
					 | 
				
			||||||
                       "The following packages will be installed:~%~{~a~%~}~%"
 | 
					 | 
				
			||||||
                       len)
 | 
					 | 
				
			||||||
                   install))))
 | 
					 | 
				
			||||||
    (_ #f)))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
;;;
 | 
					;;;
 | 
				
			||||||
;;; Package specifications.
 | 
					;;; Package specifications.
 | 
				
			||||||
| 
						 | 
					@ -866,8 +823,10 @@ more information.~%"))
 | 
				
			||||||
           (let* ((manifest    (profile-manifest profile))
 | 
					           (let* ((manifest    (profile-manifest profile))
 | 
				
			||||||
                  (install     (options->installable opts manifest))
 | 
					                  (install     (options->installable opts manifest))
 | 
				
			||||||
                  (remove      (options->removable opts manifest))
 | 
					                  (remove      (options->removable opts manifest))
 | 
				
			||||||
                  (new      (manifest-add (manifest-remove manifest remove)
 | 
					                  (transaction (manifest-transaction (install install)
 | 
				
			||||||
                                          install)))
 | 
					                                                     (remove remove)))
 | 
				
			||||||
 | 
					                  (new         (manifest-perform-transaction
 | 
				
			||||||
 | 
					                                manifest transaction)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
             (when (equal? profile %current-profile)
 | 
					             (when (equal? profile %current-profile)
 | 
				
			||||||
               (ensure-default-profile))
 | 
					               (ensure-default-profile))
 | 
				
			||||||
| 
						 | 
					@ -875,9 +834,9 @@ more information.~%"))
 | 
				
			||||||
             (unless (and (null? install) (null? remove))
 | 
					             (unless (and (null? install) (null? remove))
 | 
				
			||||||
               (let* ((prof-drv (run-with-store (%store)
 | 
					               (let* ((prof-drv (run-with-store (%store)
 | 
				
			||||||
                                                (profile-derivation new)))
 | 
					                                                (profile-derivation new)))
 | 
				
			||||||
                      (prof     (derivation->output-path prof-drv))
 | 
					                      (prof     (derivation->output-path prof-drv)))
 | 
				
			||||||
                      (remove   (manifest-matching-entries manifest remove)))
 | 
					                 (manifest-show-transaction (%store) manifest transaction
 | 
				
			||||||
                 (show-what-to-remove/install remove install dry-run?)
 | 
					                                            #:dry-run? 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?)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue