diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-07-03 22:48:04 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-07-03 23:53:31 +0200 |
| commit | f54cbc0e1b84a5b3785d3b4734600387dde82be9 (patch) | |
| tree | 779daded7c593c31f9f68f950de166716fbdec14 /guix/import/github.scm | |
| parent | 00290e7365aed9b34603bfb3cd6e8a4bdc1e7259 (diff) | |
import: Do not assume that 'package-source' returns an origin.
* guix/gnu-maintenance.scm (gnu-package?): Check whether
'package-source' returns an origin.
* guix/import/github.scm (updated-github-url): Likewise.
* guix/import/launchpad.scm (updated-launchpad-url): Likewise.
Diffstat (limited to 'guix/import/github.scm')
| -rw-r--r-- | guix/import/github.scm | 33 |
1 files changed, 18 insertions, 15 deletions
diff --git a/guix/import/github.scm b/guix/import/github.scm index 7136e7a34f..95a792d0ca 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> -;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il> @@ -90,20 +90,23 @@ false if none is recognized" (#t #f))) ; Some URLs are not recognised. #f)) - (let ((source-uri (and=> (package-source old-package) origin-uri)) - (fetch-method (and=> (package-source old-package) origin-method))) - (cond - ((eq? fetch-method download:url-fetch) - (match source-uri - ((? string?) - (updated-url source-uri)) - ((source-uri ...) - (find updated-url source-uri)))) - ((and (eq? fetch-method download:git-fetch) - (string-prefix? "https://github.com/" - (download:git-reference-url source-uri))) - (download:git-reference-url source-uri)) - (else #f)))) + (match (package-source old-package) + ((? origin? origin) + (let ((source-uri (origin-uri origin)) + (fetch-method (origin-method origin))) + (cond + ((eq? fetch-method download:url-fetch) + (match source-uri + ((? string?) + (updated-url source-uri)) + ((source-uri ...) + (find updated-url source-uri)))) + ((and (eq? fetch-method download:git-fetch) + (string-prefix? "https://github.com/" + (download:git-reference-url source-uri))) + (download:git-reference-url source-uri)) + (else #f)))) + (_ #f))) (define (github-package? package) "Return true if PACKAGE is a package from GitHub, else false." |