~ruther/guix-local

ef010c0f3d414f7107de80e0835d1e347b04315b — Ludovic Courtès 13 years ago c50cbfd
guix package: Inform about new upstream versions of GNU packages.

* guix/gnu-maintenance.scm (gnu-package?): New procedure.
* guix/scripts/package.scm (waiting): New macro.
  (check-package-freshness): New procedure.
  (guix-package)[process-actions]: Use it.
* doc/guix.texi (Invoking guix package): Mention the feature.
3 files changed, 54 insertions(+), 0 deletions(-)

M doc/guix.texi
M guix/gnu-maintenance.scm
M guix/scripts/package.scm
M doc/guix.texi => doc/guix.texi +6 -0
@@ 514,6 514,12 @@ Thus, when installing MPC, the MPFR and GMP libraries also get installed
in the profile; removing MPC also removes MPFR and GMP---unless they had
also been explicitly installed independently.

@c XXX: keep me up-to-date
Besides, when installing a GNU package, the tool reports the
availability of a newer upstream version.  In the future, it may provide
the option of installing directly from the upstream version, even if
that version is not yet in the distribution.

@item --install-from-expression=@var{exp}
@itemx -e @var{exp}
Install the package @var{exp} evaluates to.

M guix/gnu-maintenance.scm => guix/gnu-maintenance.scm +14 -0
@@ 29,7 29,9 @@
  #:use-module (system foreign)
  #:use-module (guix ftp-client)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:export (official-gnu-packages
            gnu-package?
            releases
            latest-release
            gnu-package-name->name+version))


@@ 74,6 76,18 @@
                  (and=> (regexp-exec %package-line-rx line)
                         (cut match:substring <> 1)))
                lst)))

(define gnu-package?
  (memoize
   (lambda (package)
     "Return true if PACKAGE is a GNU package.  This procedure may access the
network to check in GNU's database."
     ;; TODO: Find a way to determine that a package is non-GNU without going
     ;; through the network.
     (let ((url (origin-uri (package-source package))))
       (or (string-prefix? "mirror://gnu" url)
           (member (package-name package) (official-gnu-packages)))))))


;;;
;;; Latest release.

M guix/scripts/package.scm => guix/scripts/package.scm +34 -0
@@ 39,6 39,7 @@
  #:use-module (gnu packages)
  #:use-module ((gnu packages base) #:select (guile-final))
  #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
  #:use-module (guix gnu-maintenance)
  #:export (guix-package))

(define %store


@@ 266,6 267,38 @@ matching packages."
                       (assoc-ref (derivation-outputs drv) sub-drv))))
         `(,name ,out))))))

(define-syntax-rule (waiting exp fmt rest ...)
  "Display the given message while EXP is being evaluated."
  (let* ((message (format #f fmt rest ...))
         (blank   (make-string (string-length message) #\space)))
    (display message (current-error-port))
    (force-output (current-error-port))
    (let ((result exp))
      ;; Clear the line.
      (display #\cr (current-error-port))
      (display blank (current-error-port))
      (display #\cr (current-error-port))
      (force-output (current-error-port))
      exp)))

(define (check-package-freshness package)
  "Check whether PACKAGE has a newer version available upstream, and report
it."
  ;; TODO: Automatically inject the upstream version when desired.
  (when (gnu-package? package)
    (let ((name      (package-name package))
          (full-name (package-full-name package)))
      (match (waiting (latest-release name)
                      (_ "looking for the latest release of GNU ~a...") name)
        ((latest-version . _)
         (when (version>? latest-version full-name)
           (format (current-error-port)
                   (_ "~a: note: using ~a \
but ~a is available upstream~%")
                   (location->string (package-location package))
                   full-name latest-version)))
        (_ #t)))))


;;;
;;; Command-line options.


@@ 547,6 580,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                                      ((name version sub-drv
                                             (? package? package)
                                             (deps ...))
                                       (check-package-freshness package)
                                       (package-derivation (%store) package))
                                      (_ #f))
                                     install))