>From 2ad1f71d72d72ca742005c4244e9a997411473f0 Mon Sep 17 00:00:00 2001 From: Carlo Zancanaro Date: Sat, 28 Dec 2019 12:34:33 +1100 Subject: [PATCH] import: Add importer for MELPA packages. * guix/import/melpa.scm: New file. * guix/scripts/import/melpa.scm: New file. * guix/scripts/import.scm (importers): Add melpa importer. * doc/guix.texi: Add melpa importer to table. * Makefile.am (MODULES): Add files. --- Makefile.am | 2 + doc/guix.texi | 10 ++ guix/import/melpa.scm | 216 ++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/melpa.scm | 99 ++++++++++++++++ 5 files changed, 328 insertions(+), 1 deletion(-) create mode 100644 guix/import/melpa.scm create mode 100644 guix/scripts/import/melpa.scm diff --git a/Makefile.am b/Makefile.am index 6106250b37..0fdd829f3e 100644 --- a/Makefile.am +++ b/Makefile.am @@ -217,6 +217,7 @@ MODULES = \ guix/import/cran.scm \ guix/import/crate.scm \ guix/import/elpa.scm \ + guix/import/melpa.scm \ guix/import/gem.scm \ guix/import/github.scm \ guix/import/gnome.scm \ @@ -262,6 +263,7 @@ MODULES = \ guix/scripts/import/crate.scm \ guix/scripts/import/cran.scm \ guix/scripts/import/elpa.scm \ + guix/scripts/import/melpa.scm \ guix/scripts/import/gem.scm \ guix/scripts/import/gnu.scm \ guix/scripts/import/hackage.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index efc59c1aaf..9e75e619ff 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9215,6 +9215,16 @@ and generate package expressions for all those packages that are not yet in Guix. @end table +@item melpa +@cindex melpa +Import a package recipe from @uref{https://melpa.org/packages, MELPA}. +Unlike the ELPA importer, above, the MELPA importer does not use source +archives, but builds its package from the upstream source. + +@example +guix import melpa org-mime +@end example + @item crate @cindex crate Import metadata from the crates.io Rust package repository diff --git a/guix/import/melpa.scm b/guix/import/melpa.scm new file mode 100644 index 0000000000..cd22018589 --- /dev/null +++ b/guix/import/melpa.scm @@ -0,0 +1,216 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa +;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2018 Oleg Pykhalov +;;; Copyright © 2019 Carlo Zancanaro +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix import melpa) + #:use-module (gcrypt hash) + #:use-module (guix base32) + #:use-module (guix git) + #:use-module (guix http-client) + #:use-module (guix import utils) + #:use-module (guix serialization) + #:use-module (guix store) + #:use-module (ice-9 control) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (web uri) + #:export (melpa->guix-package)) + +(define emacs-standard-library? + (let ((libs '("emacs" "cl-lib"))) + (lambda (lib) + "Return true if LIB is part of Emacs itself. The check is not +exhaustive and only attempts to recognize a subset of packages which in the +past were distributed separately from Emacs." + (member lib libs)))) + +(define* (download-git-repository url ref) + (with-store store + (latest-repository-commit store url #:ref ref))) + +(define (package-name->recipe-url package-name) + (string-append "https://raw.githubusercontent.com/melpa/melpa/master/recipes/" + package-name)) + +(define (package-name->recipe 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 (package-name->recipe-url package-name)) + #:ttl (* 6 3600))) + (previous-keyword-mode (match (member 'keywords (read-options)) + ((_ value . _) value))) + (data (begin + (read-set! keywords 'prefix) + (read port)))) + (read-set! keywords previous-keyword-mode) + (close-port port) + (data->recipe (cons #:name data)))) + +(define (github-repo->url repo) + (string-append "https://github.com/" repo ".git")) + +(define (gitlab-repo->url repo) + (string-append "https://gitlab.com/" repo ".git")) + +;; 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 (emacs-requires->inputs requires) + (define (require-symbol->input-string require) + (let ((require-string (symbol->string (if (pair? require) + (car require) + require)))) + (if (emacs-standard-library? require-string) + #f + (string-append "emacs-" require-string)))) + + (package-names->package-inputs + (filter identity (map require-symbol->input-string requires)))) + +;; This is a regular expression that will extract the package requirements +;; from a line of elisp. See "(elisp) Library Headers" for more details about +;; this header. +(define package-depends-regexp + (make-regexp "\\s*;+\\s**package-requires:(.*)" regexp/icase)) + +(define (find-package-inputs directory) + (define (for-each-line f file) + (call-with-input-file file + (lambda (port) + (let loop () + (let ((line (read-line port 'concat))) + (unless (eof-object? line) + (f line) + (loop))))))) + + (emacs-requires->inputs + (call/ec (lambda (return) + (for-each + (lambda (filename) + (for-each-line + (lambda (line) + (let ((match-data (regexp-exec package-depends-regexp line))) + (when match-data + (return (with-input-from-string (match:substring match-data 1) + read))))) + (string-append directory "/" filename))) + (scandir directory (cut string-suffix-ci? ".el" <>))) + (return '()))))) + + +(define (git-repository->package recipe url) + (define ref + (cond + ((assoc-ref recipe #:branch) + => (lambda (branch) (cons 'branch branch))) + ((assoc-ref recipe #:commit) + => (lambda (commit) (cons 'commit commit))) + (else + '(branch . "master")))) + + (define (maybe-inputs input-type inputs) + (if (null? inputs) + (list) + (list (list input-type (list 'quasiquote inputs))))) + + (define (maybe-arguments files) + (define (glob->regexp glob) + (string-append + "^" + (regexp-substitute/global #f "\\*\\*?" glob + 'pre + (lambda (m) + (if (string= (match:substring m 0) "**") + ".*" + "[^/]+")) + 'post) + "$")) + + (if files + `((arguments '(#:include ',(map glob->regexp (remove pair? files)) + #:exclude ',(map glob->regexp (apply append + (map (match-lambda + ((#:exclude . values) + values) + (_ '())) + files)))))) + '())) + + (let-values (((directory commit) (download-git-repository url ref))) + (let ((inputs (find-package-inputs directory))) + `(package + (name ,(string-append "emacs-" (symbol->string (assoc-ref recipe #:name)))) + (version , (strftime "%Y%m%d" (gmtime (current-time)))) + (source (origin + (method git-fetch) + (uri (git-reference + (url ,url) + (commit ,commit))) + (sha256 + (base32 + ,(bytevector->nix-base32-string + (file-hash directory (negate vcs-file?) #t)))))) + (build-system emacs-build-system) + ,@(maybe-inputs 'propagated-inputs + (find-package-inputs directory)) + ,@(maybe-arguments (assoc-ref recipe #:files)) + (home-page #f) + (description #f) + (synopsis #f) + (license #f))))) + +(define (melpa->guix-package package-name) + "Construct a Guix package based on the MELPA recipe for PACKAGE-NAME." + (let ((recipe (package-name->recipe package-name))) + (match (assoc-ref recipe #:fetcher) + ('github (git-repository->package recipe + (github-repo->url (assoc-ref recipe #:repo)))) + ('gitlab (git-repository->package recipe + (gitlab-repo->url (assoc-ref recipe #:repo)))) + ('git (git-repository->package recipe + (assoc-ref recipe #:url))) + (_ (leave (G_ "Only github, gitlab, and git repositories are currently supported")))))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index c6cc93fad8..1c5fc68776 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -76,7 +76,7 @@ rather than \\n." ;;; (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem" - "cran" "crate" "texlive" "json" "opam")) + "cran" "crate" "texlive" "json" "opam" "melpa")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/melpa.scm b/guix/scripts/import/melpa.scm new file mode 100644 index 0000000000..5e298b87b2 --- /dev/null +++ b/guix/scripts/import/melpa.scm @@ -0,0 +1,99 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa +;;; Copyright © 2018 Oleg Pykhalov +;;; Copyright © 2019 Carlo Zancanaro +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix scripts import melpa) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import melpa) + #:use-module (guix import utils) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-melpa)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '((repo . gnu))) + +(define (show-help) + (display (G_ "Usage: guix import melpa PACKAGE-NAME +Import the latest package named PACKAGE-NAME from the MELPA repository recipes.\n")) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import melpa"))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive #t result))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-melpa . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (G_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (melpa->guix-package package-name))) + (unless sexp + (leave (G_ "failed to download package '~a'~%") package-name)) + sexp)) + (() + (leave (G_ "too few arguments~%"))) + ((many ...) + (leave (G_ "too many arguments~%")))))) + +;;; melpa.scm ends here -- 2.24.1