>From 3fb7b9cce90649dc880eb23e022a6a22efada657 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 26 Oct 2016 09:56:33 +0200 Subject: [PATCH 1/9] WIP --- guix/upstream.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/guix/upstream.scm b/guix/upstream.scm index a47a52be3..6ceb7881a 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -269,6 +269,8 @@ if an update was made, and #f otherwise." ;; thereof). (let ((old-hash (bytevector->nix-base32-string old-hash)) (hash (bytevector->nix-base32-string hash))) + ;; TODO: be smart and don't replace accidental matches, e.g. in "sha256" + ;; or in the description. Only replace in the "version" field. (string-replace-substring (string-replace-substring expr old-hash hash) old-version version))) -- 2.12.2 >From 4fccff582967c475e92a2150f3fd784f223b524c Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Tue, 25 Oct 2016 21:49:10 +0200 Subject: [PATCH 2/9] refresh: Suggest changes to inputs when updating. * guix/scripts/refresh.scm (updater->importer-info): New procedure. (mock): New syntax rule. (update-package): Run matching importer to suggest changes to inputs. --- guix/scripts/refresh.scm | 98 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 97 insertions(+), 1 deletion(-) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 4d3c695aa..3487685d3 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2015 Alex Kost ;;; Copyright © 2016 Ben Woodcroft +;;; Copyright © 2016 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -213,6 +214,35 @@ unavailable optional dependencies such as Guile-JSON." ((guix import github) => %github-updater) ((guix import crate) => %crate-updater))) +(define (updater->importer-info updater-name) + "Return a list containing an update procedure, a package name converter, +and, optionally, an archive symbol for the given UPDATER-NAME. Return #F for +an unknown updater." + (case updater-name + ((gnu) + (list gnu->guix-package + package-name)) + ((elpa) + (list elpa->guix-package + package-name)) + ((cran) + (list cran->guix-package + (@@ (guix import cran) package->upstream-name))) + ((bioconductor) + (list cran->guix-package + (@@ (guix import cran) package->upstream-name) + 'bioconductor)) + ((hackage) + (list hackage->guix-package + (@@ (guix import gem) guix-package->hackage-name))) + ((pypi) + (list pypi->guix-package + guix-package->pypi-name)) + ((gem) + (list gem->guix-package + (@@ (guix import gem) guix-package->gem-name))) + (else #f))) + (define (lookup-updater-by-name name) "Return the updater called NAME." (or (find (lambda (updater) @@ -253,6 +283,17 @@ unavailable optional dependencies such as Guile-JSON." (location->string (package-location package)) (package-name package))) +;; FIXME: copied from (guix tests) +(define-syntax-rule (mock (module proc replacement) body ...) + "Within BODY, replace the definition of PROC from MODULE with the definition +given by REPLACEMENT." + (let* ((m (resolve-module 'module)) + (original (module-ref m 'proc))) + (dynamic-wind + (lambda () (module-set! m 'proc replacement)) + (lambda () body ...) + (lambda () (module-set! m 'proc original))))) + (define* (update-package store package updaters #:key (key-download 'interactive) warn?) "Update the source file that defines PACKAGE with the new version. @@ -276,7 +317,62 @@ warn about packages that have no matching updater." (package-version package) version) (let ((hash (call-with-input-file tarball port-sha256))) - (update-package-source package version hash))) + (update-package-source package version hash)) + + ;; Run importer to compare inputs and suggest changes. + (let* ((updater (find (lambda (updater) + ((upstream-updater-predicate updater) package)) + updaters)) + (updater-name (upstream-updater-name updater))) + (match (updater->importer-info updater-name) + (#f #t) ; do nothing if there's no matching importer + ((importer convert-name . archive) + ;; Replace "download-to-store" to avoid downloading the + ;; tarball again. + (match (mock ((guix download) download-to-store + (lambda _ tarball)) + (apply importer (convert-name package) archive)) + ((and expr ('package fields ...)) + ;; FIXME: Is there a nicer way to match names in the + ;; package expression? Could we compare actual packages + ;; instead of only their labels? + (let* ((imported-inputs + (append + (match expr + ((path *** ('inputs + ('quasiquote ((label ('unquote sym)) ...)))) label) + (_ '())) + (match expr + ((path *** ('native-inputs + ('quasiquote ((label ('unquote sym)) ...)))) label) + (_ '())) + (match expr + ((path *** ('propagated-inputs + ('quasiquote ((label ('unquote sym)) ...)))) label) + (_ '())))) + (current-inputs + (map (match-lambda ((name pkg) name)) + (package-direct-inputs package))) + (removed + (lset-difference equal? + current-inputs + imported-inputs)) + (added + (lset-difference equal? + imported-inputs + current-inputs))) + (when (not (null? removed)) + (format (current-error-port) + (_ "~a: consider removing these inputs:~{ ~a~}~%") + (package-name package) + removed)) + (when (not (null? added)) + (format (current-error-port) + (_ "~a: consider adding these inputs:~{ ~a~}~%") + (package-name package) + added)))) + (x + (leave (_ "'~a' import failed~%") importer))))))) (warning (_ "~a: version ~a could not be \ downloaded and authenticated; not updating~%") (package-name package) version)))) -- 2.12.2 >From 6a7d1c77a4398cf53e78c95d54df2b4baa374f6a Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 5 Apr 2017 15:33:27 +0200 Subject: [PATCH 3/9] import cran: Fetch DESCRIPTION files from Github mirror. * guix/import/cran.scm (%bioconductor-svn-url): Remove variable. (bioconductor-mirror-url): New procedure. (fetch-description): Take a REPOSITORY symbol instead of a BASE-URL string. (cran->guix-package): Pass REPOSITORY symbol to "fetch-description". (latest-cran-release, latest-bioconductor-release): Adjust accordingly. (bioconductor-package?): Update comment about SVN. --- guix/import/cran.scm | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 4d36882cf..8e24f6e17 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -124,17 +124,19 @@ package definition." ;; The latest Bioconductor release is 3.4. Bioconductor packages should be ;; updated together. -(define %bioconductor-svn-url - (string-append "https://readonly:readonly@" - "hedgehog.fhcrc.org/bioconductor/branches/RELEASE_3_4/" - "madman/Rpacks/")) +(define (bioconductor-mirror-url name) + (string-append "https://raw.githubusercontent.com/Bioconductor-mirror/" + name "/release-3.4")) - -(define (fetch-description base-url name) +(define (fetch-description repository name) "Return an alist of the contents of the DESCRIPTION file for the R package -NAME, or #f in case of failure. NAME is case-sensitive." +NAME in the given REPOSITORY, or #f in case of failure. NAME is +case-sensitive." ;; This API always returns the latest release of the module. - (let ((url (string-append base-url name "/DESCRIPTION"))) + (let ((url (string-append (case repository + ((cran) (string-append %cran-url name)) + ((bioconductor) (bioconductor-mirror-url name))) + "/DESCRIPTION"))) (guard (c ((http-get-error? c) (format (current-error-port) "error: failed to retrieve package information \ @@ -290,11 +292,8 @@ from the alist META, which was derived from the R package's DESCRIPTION file." (lambda* (package-name #:optional (repo 'cran)) "Fetch the metadata for PACKAGE-NAME from REPO and return the `package' s-expression corresponding to that package, or #f on failure." - (let* ((url (case repo - ((cran) %cran-url) - ((bioconductor) %bioconductor-svn-url))) - (module-meta (fetch-description url package-name))) - (and=> module-meta (cut description->package repo <>)))))) + (and=> (fetch-description repo package-name) + (cut description->package repo <>))))) (define* (recursive-import package-name #:optional (repo 'cran)) "Generate a stream of package expressions for PACKAGE-NAME and all its @@ -385,7 +384,7 @@ dependencies." (package->upstream-name package)) (define meta - (fetch-description %cran-url upstream-name)) + (fetch-description 'cran upstream-name)) (and meta (let ((version (assoc-ref meta "Version"))) @@ -402,7 +401,7 @@ dependencies." (package->upstream-name package)) (define meta - (fetch-description %bioconductor-svn-url upstream-name)) + (fetch-description 'bioconductor upstream-name)) (and meta (let ((version (assoc-ref meta "Version"))) @@ -426,7 +425,10 @@ dependencies." "Return true if PACKAGE is an R package from Bioconductor." (let ((predicate (lambda (uri) (and (string-prefix? "http://bioconductor.org" uri) - ;; Data packages are not listed in SVN + ;; Data packages are neither listed in SVN nor on + ;; the Github mirror, so we have to exclude them + ;; from the set of bioconductor packages that can be + ;; updated automatically. (not (string-contains uri "/data/annotation/")))))) (and (string-prefix? "r-" (package-name package)) (match (and=> (package-source package) origin-uri) -- 2.12.2 >From 65ee9cdb9c30d70f168136b6148d8d56bc421f33 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 5 Apr 2017 16:59:03 +0200 Subject: [PATCH 4/9] import cran: Exclude experiment packages in predicate "bioconductor-package?". * guix/import/cran.scm (bioconductor-package?): Exclude experiment packages, because they cannot be updated with the default bioconductor updater. --- guix/import/cran.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 8e24f6e17..f63d23972 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -429,7 +429,9 @@ dependencies." ;; the Github mirror, so we have to exclude them ;; from the set of bioconductor packages that can be ;; updated automatically. - (not (string-contains uri "/data/annotation/")))))) + (not (string-contains uri "/data/annotation/")) + ;; Experiment packages are in a separate repository. + (not (string-contains uri "/data/experiment/")))))) (and (string-prefix? "r-" (package-name package)) (match (and=> (package-source package) origin-uri) ((? string? uri) -- 2.12.2 >From 2afaf8f213236a5c2ed81ea32b2fee84f13c66e0 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 5 Apr 2017 17:00:51 +0200 Subject: [PATCH 5/9] import cran: Add predicate for Bioconductor experiment packages. * guix/import/cran.scm (bioconductor-experiment-package?): New variable. --- guix/import/cran.scm | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index f63d23972..48ab7355d 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -453,6 +453,19 @@ dependencies." (any predicate uris)) (_ #f))))) +(define (bioconductor-experiment-package? package) + "Return true if PACKAGE is an R experiment package from Bioconductor." + (let ((predicate (lambda (uri) + (and (string-prefix? "http://bioconductor.org" uri) + (string-contains uri "/data/experiment/"))))) + (and (string-prefix? "r-" (package-name package)) + (match (and=> (package-source package) origin-uri) + ((? string? uri) + (predicate uri)) + ((? list? uris) + (any predicate uris)) + (_ #f))))) + (define %cran-updater (upstream-updater (name 'cran) -- 2.12.2 >From 113d2405f1fa7658ecf76f6c3a37725ad5184aed Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 5 Apr 2017 17:37:02 +0200 Subject: [PATCH 6/9] import cran: Refactor "needs-zlib?". * guix/import/cran.scm (tarball-files-match-pattern?): New procedure. (needs-zlib?): Implement in terms of "tarball-files-match-pattern?". --- guix/import/cran.scm | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 48ab7355d..be3b678cd 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -201,17 +201,16 @@ empty list when the FIELD cannot be found." (check "*.f95") (check "*.f"))) -(define (needs-zlib? tarball) - "Return #T if any of the Makevars files in the src directory of the TARBALL -contain a zlib linker flag." +(define (tarball-files-match-pattern? tarball regexp . file-patterns) + "Return #T if any of the files represented by FILE-PATTERNS in the TARBALL +match the given REGEXP." (call-with-temporary-directory (lambda (dir) - (let ((pattern (make-regexp "-lz"))) + (let ((pattern (make-regexp regexp))) (parameterize ((current-error-port (%make-void-port "rw+"))) - (system* "tar" - "xf" tarball "-C" dir - "--wildcards" - "*/src/Makevars*" "*/src/configure*" "*/configure*")) + (apply system* "tar" + "xf" tarball "-C" dir + `("--wildcards" ,@file-patterns))) (any (lambda (file) (call-with-input-file file (lambda (port) @@ -220,10 +219,16 @@ contain a zlib linker flag." (cond ((eof-object? line) #f) ((regexp-exec pattern line) #t) - (else (loop))))))) - #t) + (else (loop)))))))) (find-files dir)))))) +(define (needs-zlib? tarball) + "Return #T if any of the Makevars files in the src directory of the TARBALL +contain a zlib linker flag." + (tarball-files-match-pattern? + tarball "-lz" + "*/src/Makevars*" "*/src/configure*" "*/configure*")) + (define (description->package repository meta) "Return the `package' s-expression for an R package published on REPOSITORY from the alist META, which was derived from the R package's DESCRIPTION file." -- 2.12.2 >From d6645e03114adb35b195f532fb06069582b7bd3a Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 5 Apr 2017 17:38:06 +0200 Subject: [PATCH 7/9] import cran: Check if pkg-config is needed. * guix/import/cran.scm (needs-pkg-config?): New procedure. (description->package): Use it. --- guix/import/cran.scm | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index be3b678cd..423835637 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -229,6 +229,13 @@ contain a zlib linker flag." tarball "-lz" "*/src/Makevars*" "*/src/configure*" "*/configure*")) +(define (needs-pkg-config? tarball) + "Return #T if any of the Makevars files in the src directory of the TARBALL +reference the pkg-config tool." + (tarball-files-match-pattern? + tarball "pkg-config" + "*/src/Makevars*" "*/src/configure*" "*/configure*")) + (define (description->package repository meta) "Return the `package' s-expression for an R package published on REPOSITORY from the alist META, which was derived from the R package's DESCRIPTION file." @@ -278,11 +285,12 @@ from the alist META, which was derived from the R package's DESCRIPTION file." (build-system r-build-system) ,@(maybe-inputs sysdepends) ,@(maybe-inputs (map guix-name propagate) 'propagated-inputs) - ,@(if (needs-fortran? tarball) - `((native-inputs (,'quasiquote - ,(list "gfortran" - (list 'unquote 'gfortran))))) - '()) + ,@(maybe-inputs + `(,@(if (needs-fortran? tarball) + '("gfortran") '()) + ,@(if (needs-pkg-config? tarball) + '("pkg-config") '())) + 'native-inputs) (home-page ,(if (string-null? home-page) (string-append base-url name) home-page)) -- 2.12.2 >From 76910eaa2e9cf207d0d844cf0c1d7156f641adb8 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 5 Apr 2017 17:42:50 +0200 Subject: [PATCH 8/9] import cran: Ensure substring indices are valid. * guix/import/cran.scm (package->upstream-name): Check that "start" and "end" are valid before using them as substring indices. --- guix/import/cran.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 423835637..557d694ad 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -384,9 +384,10 @@ dependencies." ((or (? string? url) (url _ ...)) (let ((end (string-rindex url #\_)) (start (string-rindex url #\/))) - ;; The URL ends on - ;; (string-append "/" name "_" version ".tar.gz") - (substring url (+ start 1) end))) + (and start end + ;; The URL ends on + ;; (string-append "/" name "_" version ".tar.gz") + (substring url (+ start 1) end)))) (_ #f))) (_ #f))))) -- 2.12.2 >From 1f2ae28f2754053719edf196348d5acb409810df Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 5 Apr 2017 17:43:52 +0200 Subject: [PATCH 9/9] import cran: Skip updating when meta data cannot be downloaded. * gnu/packages/bioinformatics.scm (latest-cran-release, latest-bioconductor-release): Abort early when meta data cannot be downloaded. --- guix/import/cran.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 557d694ad..fc7a1ed84 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -398,7 +398,8 @@ dependencies." (package->upstream-name package)) (define meta - (fetch-description 'cran upstream-name)) + (false-if-exception + (fetch-description 'cran upstream-name))) (and meta (let ((version (assoc-ref meta "Version"))) @@ -415,7 +416,8 @@ dependencies." (package->upstream-name package)) (define meta - (fetch-description 'bioconductor upstream-name)) + (false-if-exception + (fetch-description 'bioconductor upstream-name))) (and meta (let ((version (assoc-ref meta "Version"))) -- 2.12.2