From: Carlo Zancanaro <carlo@zancanaro.id.au>
To: Brett Gilio <brettg@gnu.org>
Cc: 38769@debbugs.gnu.org
Subject: [bug#38769] [PATCH] import: Add importer for MELPA packages.
Date: Wed, 18 Mar 2020 13:54:52 +1100 [thread overview]
Message-ID: <874kum9xtv.fsf@zancanaro.id.au> (raw)
In-Reply-To: <87r20bqco9.fsf@gnu.org>
[-- Attachment #1: Type: text/plain, Size: 362 bytes --]
Hey Brett!
It's been a while, but I've finally found time to revisit this
patch.
On Wed, Jan 08 2020, Brett Gilio wrote:
> ... we /should/ combine this with the ELPA importer in its
> current tradition: `guix import elpa -a melpa`. That seems
> preferable to me, as it would avoid the need to deprecate a
> command flag in our UX.
I've done this.
Carlo
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-import-elpa-Fetch-MELPA-packages-with-a-stable-git-r.patch --]
[-- Type: text/x-diff, Size: 9873 bytes --]
From eee82d9668410c3b71884082fa770417f6b53921 Mon Sep 17 00:00:00 2001
From: Carlo Zancanaro <carlo@zancanaro.id.au>
Date: Wed, 18 Mar 2020 13:38:50 +1100
Subject: [PATCH] import: elpa: Fetch MELPA packages with a stable
git-reference.
* guix/import/elpa.scm (default-files-spec): New variable.
(download-git-repository, package-name->melpa-recipe, file-hash, vcs-file?,
git-repository->origin, melpa-recipe->origin, melpa-recipe->maybe-arguments):
New procedures.
(elpa-package->sexp): Add optional repo argument, and use it to determine
whether to attempt to construct a source using the MELPA recipe.
(elpa->guix-package): Pass repo to elpa-package->sexp.
---
guix/import/elpa.scm | 189 +++++++++++++++++++++++++++++++++++++------
1 file changed, 166 insertions(+), 23 deletions(-)
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 2d4487dba0..2483b57385 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -21,6 +21,7 @@
(define-module (guix import elpa)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
+ #:use-module (ice-9 regex)
#:use-module (web uri)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
@@ -30,6 +31,8 @@
#:use-module ((guix download) #:select (download-to-store))
#:use-module (guix import utils)
#:use-module (guix http-client)
+ #:use-module (guix git)
+ #:use-module ((guix serialization) #:select (write-file))
#:use-module (guix store)
#:use-module (guix ui)
#:use-module (gcrypt hash)
@@ -195,10 +198,143 @@ include VERSION."
url)))
(_ #f))))
-(define* (elpa-package->sexp pkg #:optional license)
+(define* (download-git-repository url ref)
+ "Fetch the given REF from the Git repository at URL."
+ (with-store store
+ (latest-repository-commit store url #:ref ref)))
+
+(define (package-name->melpa-recipe package-name)
+ "Fetch the MELPA recipe for PACKAGE-NAME, represented as an alist from
+keywords to values."
+ (define recipe-url
+ (string-append "https://raw.githubusercontent.com/melpa/melpa/master/recipes/"
+ package-name))
+
+ (define (data->recipe data)
+ (match data
+ (() '())
+ ((key value . tail)
+ (cons (cons key value) (data->recipe tail)))))
+
+ (let* ((port (http-fetch/cached (string->uri recipe-url)
+ #:ttl (* 6 3600)))
+ (data (read port)))
+ (close-port port)
+ (data->recipe (cons ':name data))))
+
+;; XXX adapted from (guix scripts hash)
+(define (file-hash file select? recursive?)
+ ;; Compute the hash of FILE.
+ (if recursive?
+ (let-values (((port get-hash) (open-sha256-port)))
+ (write-file file port #:select? select?)
+ (force-output port)
+ (get-hash))
+ (call-with-input-file file port-sha256)))
+
+;; XXX taken from (guix scripts hash)
+(define (vcs-file? file stat)
+ (case (stat:type stat)
+ ((directory)
+ (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
+ ((regular)
+ ;; Git sub-modules have a '.git' file that is a regular text file.
+ (string=? (basename file) ".git"))
+ (else
+ #f)))
+
+(define (git-repository->origin recipe url)
+ "Fetch origin details from the Git repository at URL for the provided MELPA
+RECIPE."
+ (define ref
+ (cond
+ ((assoc-ref recipe #:branch)
+ => (lambda (branch) (cons 'branch branch)))
+ ((assoc-ref recipe #:commit)
+ => (lambda (commit) (cons 'commit commit)))
+ (else
+ '(branch . "master"))))
+
+ (let-values (((directory commit) (download-git-repository url ref)))
+ `(origin
+ (method git-fetch)
+ (uri (git-reference
+ (url ,url)
+ (commit ,commit)))
+ (sha256
+ (base32
+ ,(bytevector->nix-base32-string
+ (file-hash directory (negate vcs-file?) #t)))))))
+
+(define* (melpa-recipe->origin recipe)
+ "Fetch origin details from the MELPA recipe and associated repository for
+the package named PACKAGE-NAME."
+ (define (github-repo->url repo)
+ (string-append "https://github.com/" repo ".git"))
+ (define (gitlab-repo->url repo)
+ (string-append "https://gitlab.com/" repo ".git"))
+
+ (match (assq-ref recipe ':fetcher)
+ ('github (git-repository->origin recipe (github-repo->url (assq-ref recipe ':repo))))
+ ('gitlab (git-repository->origin recipe (gitlab-repo->url (assq-ref recipe ':repo))))
+ ('git (git-repository->origin recipe (assq-ref recipe ':url)))
+ (#f #f) ; if we're not using melpa then this stops us printing a warning
+ (_ (warning (G_ "Unsupported MELPA fetcher: ~a, falling back to unstable MELPA source.~%")
+ (assq-ref recipe ':fetcher))
+ #f)))
+
+(define default-files-spec
+ ;; This contains more than just the things contained in %default-include and
+ ;; %default-exclude, presumably because this includes source files (*.in,
+ ;; *.texi, etc.) which have already been processed for releases.
+ ;;
+ ;; Taken from:
+ ;; https://github.com/melpa/melpa/blob/e8dc709d0ab2b4a68c59315f42858bcb86095f11/package-build/package-build.el#L580-L585
+ '("*.el" "*.el.in" "dir"
+ "*.info" "*.texi" "*.texinfo"
+ "doc/dir" "doc/*.info" "doc/*.texi" "doc/*.texinfo"
+ (:exclude ".dir-locals.el" "test.el" "tests.el" "*-test.el" "*-tests.el")))
+
+(define* (melpa-recipe->maybe-arguments melpa-recipe)
+ "Extract arguments for the build system from MELPA-RECIPE."
+ (define (glob->regexp glob)
+ (string-append
+ "^"
+ (regexp-substitute/global #f "\\*\\*?" glob
+ 'pre
+ (lambda (m)
+ (if (string= (match:substring m 0) "**")
+ ".*"
+ "[^/]+"))
+ 'post)
+ "$"))
+
+ (let ((files (assq-ref melpa-recipe ':files)))
+ (if files
+ (let* ((with-default (apply append (map (lambda (entry)
+ (if (eq? ':defaults entry)
+ default-files-spec
+ (list entry)))
+ files)))
+ (inclusions (remove pair? with-default))
+ (exclusions (apply append (map (match-lambda
+ ((':exclude . values)
+ values)
+ (_ '()))
+ with-default))))
+ `((arguments '(#:include ',(map glob->regexp inclusions)
+ #:exclude ',(map glob->regexp exclusions)))))
+ '())))
+
+(define* (elpa-package->sexp pkg #:optional license repo)
"Return the `package' S-expression for the Emacs package PKG, a record of
type '<elpa-package>'."
+ (define melpa-recipe
+ (if (eq? repo 'melpa)
+ (package-name->melpa-recipe (elpa-package-name pkg))
+ #f))
+
(define name (elpa-package-name pkg))
(define version (elpa-package-version pkg))
@@ -223,27 +359,34 @@ type '<elpa-package>'."
(list (list input-type
(list 'quasiquote inputs))))))
- (let ((tarball (with-store store
- (download-to-store store source-url))))
- (values
- `(package
- (name ,(elpa-name->package-name name))
- (version ,version)
- (source (origin
- (method url-fetch)
- (uri (string-append ,@(factorize-uri source-url version)))
- (sha256
- (base32
- ,(if tarball
- (bytevector->nix-base32-string (file-sha256 tarball))
- "failed to download package")))))
- (build-system emacs-build-system)
- ,@(maybe-inputs 'propagated-inputs dependencies)
- (home-page ,(elpa-package-home-page pkg))
- (synopsis ,(elpa-package-synopsis pkg))
- (description ,(elpa-package-description pkg))
- (license ,license))
- dependencies-names)))
+ (define melpa-source
+ (melpa-recipe->origin melpa-recipe))
+
+ (values
+ `(package
+ (name ,(elpa-name->package-name name))
+ (version ,version)
+ (source ,(or melpa-source
+ (let ((tarball (with-store store
+ (download-to-store store source-url))))
+ `(origin
+ (method url-fetch)
+ (uri (string-append ,@(factorize-uri source-url version)))
+ (sha256
+ (base32
+ ,(if tarball
+ (bytevector->nix-base32-string (file-sha256 tarball))
+ "failed to download package")))))))
+ (build-system emacs-build-system)
+ ,@(maybe-inputs 'propagated-inputs dependencies)
+ ,@(if melpa-source
+ (melpa-recipe->maybe-arguments melpa-recipe)
+ '())
+ (home-page ,(elpa-package-home-page pkg))
+ (synopsis ,(elpa-package-synopsis pkg))
+ (description ,(elpa-package-description pkg))
+ (license ,license))
+ dependencies-names))
(define* (elpa->guix-package name #:optional (repo 'gnu))
"Fetch the package NAME from REPO and produce a Guix package S-expression."
@@ -253,7 +396,7 @@ type '<elpa-package>'."
;; ELPA is known to contain only GPLv3+ code. Other repos may contain
;; code under other license but there's no license metadata.
(let ((license (and (memq repo '(gnu gnu/http)) 'license:gpl3+)))
- (elpa-package->sexp package license)))))
+ (elpa-package->sexp package license repo)))))
\f
;;;
--
2.25.1
next prev parent reply other threads:[~2020-03-18 2:56 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-12-28 1:59 [bug#38769] [PATCH] import: Add importer for MELPA packages Carlo Zancanaro
2020-01-07 19:39 ` Brett Gilio
2020-03-18 2:54 ` Carlo Zancanaro [this message]
2020-05-30 14:26 ` Carlo Zancanaro
2020-07-25 1:49 ` Brett Gilio
2020-12-18 10:32 ` Christopher Baines
2020-12-18 11:16 ` Carlo Zancanaro
2020-12-18 12:40 ` bug#38769: " Christopher Baines
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=874kum9xtv.fsf@zancanaro.id.au \
--to=carlo@zancanaro.id.au \
--cc=38769@debbugs.gnu.org \
--cc=brettg@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).