Merge branch 'master' into core-updates-frozen

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

diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 8922e57..05b4a45 100644 (file)
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -1,8 +1,10 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
-;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +31,8 @@
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module ((guix download) #:select (download-to-store))
   #:use-module (guix import utils)
   #:use-module (guix http-client)
@@ -77,6 +81,7 @@ NAMES (strings)."
   (let ((elpa-archives
          '((gnu . "https://elpa.gnu.org/packages")
            (gnu/http . "http://elpa.gnu.org/packages") ;for testing
+           (nongnu . "https://elpa.nongnu.org/nongnu")
            (melpa-stable . "https://stable.melpa.org/packages")
            (melpa . "https://melpa.org/packages"))))
     (assq-ref elpa-archives repo)))
@@ -254,7 +259,7 @@ RECIPE."
      ((assoc-ref recipe #:commit)
       => (lambda (commit) (cons 'commit commit)))
      (else
-      '(branch . "master"))))
+      '())))
 
   (let-values (((directory commit) (download-git-repository url ref)))
     `(origin
@@ -347,9 +352,7 @@ type '<elpa-package>'."
                           (elpa-package-inputs pkg))))
 
   (define dependencies
-    (map (lambda (n)
-           (let ((new-n (elpa-name->package-name n)))
-             (list new-n (list 'unquote (string->symbol new-n)))))
+    (map (compose string->symbol elpa-name->package-name)
          dependencies-names))
 
   (define (maybe-inputs input-type inputs)
@@ -357,8 +360,7 @@ type '<elpa-package>'."
       (()
        '())
       ((inputs ...)
-       (list (list input-type
-                   (list 'quasiquote inputs))))))
+       (list (list input-type `(list ,@inputs))))))
 
   (define melpa-source
     (melpa-recipe->origin melpa-recipe))
@@ -392,7 +394,12 @@ type '<elpa-package>'."
 (define* (elpa->guix-package name #:key (repo 'gnu) version)
   "Fetch the package NAME from REPO and produce a Guix package S-expression."
   (match (fetch-elpa-package name repo)
-    (#f #f)
+    (#false
+     (raise (condition
+             (&message
+              (message (format #false
+                               "couldn't find meta-data for ELPA package `~a'."
+                               name))))))
     (package
       ;; ELPA is known to contain only GPLv3+ code.  Other repos may contain
       ;; code under other license but there's no license metadata.
@@ -411,19 +418,24 @@ type '<elpa-package>'."
         (string-drop (package-name package) 6)
         (package-name package)))
 
-  (let* ((repo    'gnu)
-         (info    (elpa-package-info name repo))
-         (version (match info
-                    ((name raw-version . _)
-                     (elpa-version->string raw-version))))
-         (url     (match info
-                    ((_ raw-version reqs synopsis kind . rest)
-                     (package-source-url kind name version repo)))))
-    (upstream-source
-     (package (package-name package))
-     (version version)
-     (urls (list url))
-     (signature-urls (list (string-append url ".sig"))))))
+  (define repo 'gnu)
+
+  (match (elpa-package-info name repo)
+    (#f
+     ;; No info, perhaps because PACKAGE is not truly an ELPA package.
+     #f)
+    (info
+     (let* ((version (match info
+                       ((name raw-version . _)
+                        (elpa-version->string raw-version))))
+            (url     (match info
+                       ((_ raw-version reqs synopsis kind . rest)
+                        (package-source-url kind name version repo)))))
+       (upstream-source
+        (package (package-name package))
+        (version version)
+        (urls (list url))
+        (signature-urls (list (string-append url ".sig"))))))))
 
 (define package-from-gnu.org?
   (url-predicate (lambda (url)