gnu: Add r-all.

[jackhill/guix/guix.git] / guix / import / github.scm

diff --git a/guix/import/github.scm b/guix/import/github.scm
index ad662e7..cdac704 100644 (file)
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
 ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,7 +55,6 @@ false if none is recognized"
                                       (github-user-slash-repository url)))
               (repo    (github-repository url)))
           (cond
-           ((string-suffix? ".git" url) url)
            ((string-suffix? (string-append "/tarball/v" version) url)
             (string-append prefix "/tarball/v" new-version))
            ((string-suffix? (string-append "/tarball/" version) url)
@@ -98,8 +98,10 @@ false if none is recognized"
               (updated-url source-uri))
              ((source-uri ...)
               (find updated-url source-uri))))
-     ((eq? fetch-method download:git-fetch)
-      (updated-url (download:git-reference-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))))
 
 (define (github-package? package)
@@ -169,6 +171,32 @@ empty list."
   "Return a string of the newest released version name given a string URL like
 'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of
 the package e.g. 'bedtools2'.  Return #f if there is no releases"
+  (define (pre-release? x)
+    (hash-ref x "prerelease"))
+
+  (define (release->version release)
+    (let ((tag (or (hash-ref release "tag_name") ;a "release"
+                   (hash-ref release "name")))   ;a tag
+          (name-length (string-length package-name)))
+      (cond
+       ;; some tags include the name of the package e.g. "fdupes-1.51"
+       ;; so remove these
+       ((and (< name-length (string-length tag))
+             (string=? (string-append package-name "-")
+                       (substring tag 0 (+ name-length 1))))
+        (substring tag (+ name-length 1)))
+       ;; some tags start with a "v" e.g. "v0.25.0"
+       ;; where some are just the version number
+       ((string-prefix? "v" tag)
+        (substring tag 1))
+       ;; Finally, reject tags that don't start with a digit:
+       ;; they may not represent a release.
+       ((and (not (string-null? tag))
+             (char-set-contains? char-set:digit
+                                 (string-ref tag 0)))
+        tag)
+       (else #f))))
+
   (let* ((json (fetch-releases-or-tags url)))
     (if (eq? json #f)
         (if (%github-token)
@@ -178,40 +206,13 @@ API when using a GitHub token")
 API. This may be fixed by using an access token and setting the environment
 variable GUIX_GITHUB_TOKEN, for instance one procured from
 https://github.com/settings/tokens"))
-        (let loop ((releases
-                    (filter
-                     (lambda (x)
-                       ;; example pre-release:
-                       ;; https://github.com/wwood/OrfM/releases/tag/v0.5.1
-                       ;; or an all-prerelease set
-                       ;; https://github.com/powertab/powertabeditor/releases
-                       (not (hash-ref x "prerelease")))
-                     json)))
-          (match releases
-            (()                                   ;empty release list
-             #f)
-            ((release . rest)                     ;one or more releases
-             (let ((tag (or (hash-ref release "tag_name") ;a "release"
-                            (hash-ref release "name")))   ;a tag
-                   (name-length (string-length package-name)))
-               ;; some tags include the name of the package e.g. "fdupes-1.51"
-               ;; so remove these
-               (if (and (< name-length (string-length tag))
-                        (string=? (string-append package-name "-")
-                                  (substring tag 0 (+ name-length 1))))
-                   (substring tag (+ name-length 1))
-                   ;; some tags start with a "v" e.g. "v0.25.0"
-                   ;; where some are just the version number
-                   (if (string-prefix? "v" tag)
-                       (substring tag 1)
-
-                       ;; Finally, reject tags that don't start with a digit:
-                       ;; they may not represent a release.
-                       (if (and (not (string-null? tag))
-                                (char-set-contains? char-set:digit
-                                                    (string-ref tag 0)))
-                           tag
-                           (loop rest)))))))))))
+        (match (sort (filter-map release->version
+                                 (match (remove pre-release? json)
+                                   (() json) ; keep everything
+                                   (releases releases)))
+                     version>?)
+          ((latest-release . _) latest-release)
+          (() #f)))))
 
 (define (latest-release pkg)
   "Return an <upstream-source> for the latest release of PKG."