~ruther/guix-local

7d27a0259bc7a37c04b17ffc2953837fcc3e75ff — Ludovic Courtès 10 years ago 85c7e8e
upstream: Pass a package object to updaters.

* guix/upstream.scm (package-update-path): Pass PACKAGE to
'latest-release'.
* guix/gnu-maintenance.scm (latest-release*)
(latest-gnome-release, latest-xorg-release): Adjust accordingly.
* guix/import/cran.scm (latest-cran-release):
(latest-bioconductor-release): Likewise.
* guix/import/elpa.scm (latest-release): Likewise.
* guix/import/gem.scm (latest-release): Likewise.
* guix/import/github.scm (latest-release): Likewise.
* guix/import/hackage.scm (latest-release): Likewise.
* guix/import/pypi.scm (latest-release): Likewise.
M guix/gnu-maintenance.scm => guix/gnu-maintenance.scm +5 -6
@@ 33,7 33,6 @@
  #:use-module (guix records)
  #:use-module (guix upstream)
  #:use-module (guix packages)
  #:use-module (gnu packages)
  #:export (gnu-package-name
            gnu-package-mundane-name
            gnu-package-copyright-holder


@@ 435,7 434,7 @@ of EXP otherwise."
  "Like 'latest-release', but ignore FTP errors that might occur when PACKAGE
is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that
name (this is the case for \"emacs-auctex\", for instance.)"
  (false-if-ftp-error (latest-release package)))
  (false-if-ftp-error (latest-release (package-name package))))

(define %package-name-rx
  ;; Regexp for a package name, e.g., "foo-X.Y".  Since TeXmacs uses


@@ 493,10 492,10 @@ elpa.gnu.org, and all the GNOME packages."
      (even-minor-version? (or version name))))

  (false-if-ftp-error
   (latest-ftp-release package
   (latest-ftp-release (package-name package)
                       #:server "ftp.gnome.org"
                       #:directory (string-append "/pub/gnome/sources/"
                                                  (match package
                                                  (match (package-name package)
                                                    ("gconf" "GConf")
                                                    (x       x)))



@@ 528,10 527,10 @@ elpa.gnu.org, and all the GNOME packages."

(define (latest-xorg-release package)
  "Return the latest release of PACKAGE, the name of an X.org package."
  (let ((uri (string->uri (origin-uri (package-source (specification->package package))))))
  (let ((uri (string->uri (origin-uri (package-source package)))))
    (false-if-ftp-error
     (latest-ftp-release
      package
      (package-name package)
      #:server "ftp.freedesktop.org"
      #:directory
      (string-append "/pub/xorg/" (dirname (uri-path uri)))))))

M guix/import/cran.scm => guix/import/cran.scm +5 -6
@@ 1,6 1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 32,7 32,6 @@
  #:use-module ((guix build-system r) #:select (cran-uri bioconductor-uri))
  #:use-module (guix upstream)
  #:use-module (guix packages)
  #:use-module (gnu packages)
  #:export (cran->guix-package
            bioconductor->guix-package
            %cran-updater


@@ 240,7 239,7 @@ s-expression corresponding to that package, or #f on failure."
  "Return an <upstream-source> for the latest release of PACKAGE."

  (define upstream-name
    (package->upstream-name (specification->package package)))
    (package->upstream-name package))

  (define meta
    (fetch-description %cran-url upstream-name))


@@ 249,7 248,7 @@ s-expression corresponding to that package, or #f on failure."
       (let ((version (assoc-ref meta "Version")))
         ;; CRAN does not provide signatures.
         (upstream-source
          (package package)
          (package (package-name package))
          (version version)
          (urls (cran-uri upstream-name version))))))



@@ 257,7 256,7 @@ s-expression corresponding to that package, or #f on failure."
  "Return an <upstream-source> for the latest release of PACKAGE."

  (define upstream-name
    (package->upstream-name (specification->package package)))
    (package->upstream-name package))

  (define meta
    (fetch-description %bioconductor-svn-url upstream-name))


@@ 266,7 265,7 @@ s-expression corresponding to that package, or #f on failure."
       (let ((version (assoc-ref meta "Version")))
         ;; Bioconductor does not provide signatures.
         (upstream-source
          (package package)
          (package (package-name package))
          (version version)
          (urls (bioconductor-uri upstream-name version))))))


M guix/import/elpa.scm => guix/import/elpa.scm +6 -8
@@ 1,6 1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 239,13 239,11 @@ type '<elpa-package>'."
;;;

(define (latest-release package)
  "Return an <upstream-release> for the latest release of PACKAGE.  PACKAGE
may be a Guix package name such as \"emacs-debbugs\" or an upstream name such
as \"debbugs\"."
  "Return an <upstream-release> for the latest release of PACKAGE."
  (define name
    (if (string-prefix? "emacs-" package)
        (string-drop package 6)
        package))
    (if (string-prefix? "emacs-" (package-name package))
        (string-drop (package-name package) 6)
        (package-name package)))

  (let* ((repo    'gnu)
         (info    (elpa-package-info name repo))


@@ 256,7 254,7 @@ as \"debbugs\"."
                    ((_ raw-version reqs synopsis kind . rest)
                     (package-source-url kind name version repo)))))
    (upstream-source
     (package package)
     (package (package-name package))
     (version version)
     (urls (list url))
     (signature-urls (list (string-append url ".sig"))))))

M guix/import/gem.scm => guix/import/gem.scm +4 -6
@@ 32,7 32,6 @@
  #:use-module (guix licenses)
  #:use-module (guix base32)
  #:use-module (guix build-system ruby)
  #:use-module (gnu packages)
  #:export (gem->guix-package
            %gem-updater))



@@ 171,15 170,14 @@ package on RubyGems."
           ((source-url ...)
            (any rubygems-url? source-url))))))

(define (latest-release guix-package)
  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
  (let* ((gem-name (guix-package->gem-name
                    (specification->package guix-package)))
(define (latest-release package)
  "Return an <upstream-source> for the latest release of PACKAGE."
  (let* ((gem-name (guix-package->gem-name package))
         (metadata (rubygems-fetch gem-name))
         (version (assoc-ref metadata "version"))
         (url (rubygems-uri gem-name version)))
    (upstream-source
     (package guix-package)
     (package (package-name package))
     (version version)
     (urls (list url)))))


M guix/import/github.scm => guix/import/github.scm +4 -6
@@ 25,7 25,6 @@
  #:use-module (guix import utils)
  #:use-module (guix packages)
  #:use-module (guix upstream)
  #:use-module (gnu packages)
  #:use-module (web uri)
  #:export (%github-updater))



@@ 175,15 174,14 @@ https://github.com/settings/tokens"))
                   (if (eq? (string-ref tag 0) #\v)
                       (substring tag 1) tag)))))))))

(define (latest-release guix-package)
  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
  (let* ((pkg (specification->package guix-package))
         (source-uri (origin-uri (package-source pkg)))
(define (latest-release pkg)
  "Return an <upstream-source> for the latest release of PKG."
  (let* ((source-uri (origin-uri (package-source pkg)))
         (name (package-name pkg))
         (newest-version (latest-released-version source-uri name)))
    (if newest-version
        (upstream-source
         (package pkg)
         (package name)
         (version newest-version)
         (urls (list (updated-github-url pkg newest-version))))
        #f))) ; On GitHub but no proper releases

M guix/import/hackage.scm => guix/import/hackage.scm +4 -6
@@ 23,7 23,6 @@
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-1)
  #:use-module (gnu packages)
  #:use-module ((guix download) #:select (download-to-store url-fetch))
  #:use-module ((guix utils) #:select (package-name->name+version
                                       canonical-newline-port))


@@ 269,10 268,9 @@ respectively."
           ((source-url ...)
            (any haskell-url? source-url))))))

(define (latest-release guix-package)
  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
  (let* ((hackage-name (guix-package->hackage-name
                        (specification->package guix-package)))
(define (latest-release package)
  "Return an <upstream-source> for the latest release of PACKAGE."
  (let* ((hackage-name (guix-package->hackage-name package))
         (cabal-meta (hackage-fetch hackage-name)))
    (match cabal-meta
      (#f


@@ 283,7 281,7 @@ respectively."
      ((_ *** ("version" (version)))
       (let ((url (hackage-source-url hackage-name version)))
         (upstream-source
          (package guix-package)
          (package (package-name package))
          (version version)
          (urls (list url))))))))


M guix/import/pypi.scm => guix/import/pypi.scm +4 -6
@@ 40,7 40,6 @@
  #:use-module (guix upstream)
  #:use-module (guix licenses)
  #:use-module (guix build-system python)
  #:use-module (gnu packages)
  #:use-module (gnu packages python)
  #:export (pypi->guix-package
            %pypi-updater))


@@ 248,16 247,15 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
           ((source-url ...)
            (any pypi-url? source-url))))))

(define (latest-release guix-package)
  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
(define (latest-release package)
  "Return an <upstream-source> for the latest release of PACKAGE."
  (guard (c ((missing-source-error? c) #f))
    (let* ((pypi-name (guix-package->pypi-name
                       (specification->package guix-package)))
    (let* ((pypi-name (guix-package->pypi-name package))
           (metadata (pypi-fetch pypi-name))
           (version (assoc-ref* metadata "info" "version"))
           (url (assoc-ref (latest-source-release metadata) "url")))
      (upstream-source
       (package guix-package)
       (package (package-name package))
       (version version)
       (urls (list url))))))


M guix/upstream.scm => guix/upstream.scm +3 -3
@@ 128,11 128,11 @@ them matches."
       updaters))

(define (package-update-path package updaters)
  "Return an upstream source to update PACKAGE to, or #f if no update is
needed or known."
  "Return an upstream source to update PACKAGE, a <package> object, or #f if
no update is needed or known."
  (match (lookup-updater package updaters)
    ((? procedure? latest-release)
     (match (latest-release (package-name package))
     (match (latest-release package)
       ((and source ($ <upstream-source> name version))
        (and (version>? version (package-version package))
             source))