Hey Ricardo, Apologies if the mail client I'm using butchers the formatting... my Emacs mail setup isn't working quite right now so I'm using something else. I hope you can still read my feedback well enough.
>From 3c0859e4086d9648119a3eb3ebff884a5ec07b47 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus <ricardo.wur...@mdc-berlin.de> Date: Fri, 24 Jul 2015 16:49:57 +0200 Subject: [PATCH 1/2] import: Add 'cran' importer. * guix/import/cran.scm: New file. * guix/scripts/import.scm: Add "cran" to 'importers'. * guix/scripts/import/cran.scm: New file. * Makefile.am (MODULES): Add 'guix/import/cran.scm' and 'guix/scripts/import/cran.scm'. * doc/guix.texi (Invoking guix import): Document it. * po/guix/POTFILES.in: Add 'guix/scripts/import/cran.scm'. --- Makefile.am | 2 + doc/guix.texi | 12 +++ guix/import/cran.scm | 190 +++++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/cran.scm | 92 +++++++++++++++++++++ 5 files changed, 297 insertions(+), 1 deletion(-) create mode 100644 guix/import/cran.scm create mode 100644 guix/scripts/import/cran.scm diff --git a/Makefile.am b/Makefile.am index ada4cbe..b397962 100644 --- a/Makefile.am +++ b/Makefile.am @@ -98,6 +98,7 @@ MODULES = \ guix/import/gnu.scm \ guix/import/snix.scm \ guix/import/cabal.scm \ + guix/import/cran.scm \ guix/import/hackage.scm \ guix/import/elpa.scm \ guix/scripts/download.scm \ @@ -113,6 +114,7 @@ MODULES = \ guix/scripts/refresh.scm \ guix/scripts/system.scm \ guix/scripts/lint.scm \ + guix/scripts/import/cran.scm \ guix/scripts/import/gnu.scm \ guix/scripts/import/nix.scm \ guix/scripts/import/hackage.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 24b2039..77e47c0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3867,6 +3867,18 @@ Perl module: guix import cpan Acme::Boolean @end example +@item cran +@cindex CRAN +Import meta-data from @uref{http://cran.r-project.org/, CRAN}. +Information is extracted from the HTML package description. + +The command command below imports meta-data for the @code{Cairo} +R package: + +@example +guix import cran Cairo +@end example + @item nix Import meta-data from a local copy of the source of the @uref{http://nixos.org/nixpkgs/, Nixpkgs distribution}@footnote{This diff --git a/guix/import/cran.scm b/guix/import/cran.scm new file mode 100644 index 0000000..805eeb3 --- /dev/null +++ b/guix/import/cran.scm @@ -0,0 +1,57 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ricardo Wurmus <rek...@elephly.net> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(define-module (guix import cran) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (sxml simple) + #:use-module (sxml match) + #:use-module (sxml xpath) + #:use-module (guix http-client) + #:use-module (guix hash) + #:use-module (guix store) + #:use-module (guix base32) + #:use-module ((guix download) #:select (download-to-store)) + #:use-module (guix import utils) + #:export (cran->guix-package)) + +;;; Commentary: +;;; +;;; Generate a package declaration template for the latest version of an R +;;; package on CRAN, using the HTML description downloaded from +;;; cran.r-project.org. +;;; +;;; Code: + +(define string->license + (match-lambda + ("AGPL-3" 'agpl3) + ("Artistic-2.0" 'artistic2.0) + ("Apache License 2.0" 'asl2.0) + ("BSD_2_clause" 'bsd-2) + ("BSD_3_clause" 'bsd-3) + ("GPL-2" 'gpl2) + ("GPL-3" 'GPL3) + ("LGPL-2" 'lgpl2.0) + ("LGPL-2.1" 'lgpl2.1) + ("LGPL-3" 'lgpl3) + ("MIT" 'x11) + ((x) (string->license x)) + ((lst ...) `(list ,@(map string->license lst))) + (_ #f))) With the addition of the Ruby gem importer, I have factorized string->license into (guix import utils). Once this importer and the gem importer have reached master, would you like to merge this procedure with the factorized one? + +(define (format-inputs names) + "Generate a sorted list of package inputs from a list of package NAMES." + (sort + (map (lambda (name) + (list name (list 'unquote (string->symbol name)))) + names) + (lambda args + (match args + (((a _ ...) (b _ ...)) + (string-ci<? a b)))))) + +(define (maybe-inputs package-inputs) + "Given a list of PACKAGE-INPUTS, tries to generate the 'inputs' field of a +package definition." + (match package-inputs + (() + '()) + ((package-inputs ...) + `((inputs (,'quasiquote ,(format-inputs package-inputs))))))) Should these be propagated inputs? + +(define %cran-url "http://cran.r-project.org/web/packages/") + +(define (cran-fetch name) + "Return an sxml representation of the CRAN page for the R package NAME, +or #f on failure. NAME is case-sensitive." + ;; This API always returns the latest release of the module. + (let ((cran-url (string-append %cran-url name))) + (false-if-exception + (xml->sxml (http-fetch cran-url) + #:trim-whitespace? #t + #:namespaces '((xhtml . "http://www.w3.org/1999/xhtml")) + #:default-entity-handler + (lambda (port name) + (case name + ((nbsp) " ") + ((ge) ">=") + ((gt) ">") + ((lt) "<") + (else + (format (current-warning-port) + "~a:~a:~a: undefined entitity: ~a\n" + cran-url (port-line port) (port-column port) + name) + (symbol->string name)))))))) + +(define (cran-sxml->sexp sxml) + "Return the `package' s-expression for a CRAN package from the SXML +representation of the package page." + (define (nodes->text nodeset) + (string-join ((sxpath '(// *text*)) nodeset) " ")) + + ;; Extract the datum node next to a LABEL in the sxml table TREE. + (define (table-datum tree label) + (let ((label-node ((sxpath `(xhtml:tr (equal? (xhtml:td ,label)))) tree))) + (if (null? label-node) + '() + ((node-pos 1) + ((take-after (node-eq? (car label-node))) + ((node-join + (node-parent tree) + (select-kids (node-typeof? '*))) + label-node)))))) + + (define (guix-name name) + (if (string-prefix? "r-" name) + (string-downcase name) + (string-append "r-" (string-downcase name)))) + + (sxml-match-let* + (((xhtml:html + ,head + (xhtml:body + (xhtml:h2 ,name-and-synopsis) + (xhtml:p ,description) + ,summary + (xhtml:h4 "Downloads:") ,downloads + . ,rest)) + (cadr sxml))) Can we avoid this cadr call and use 'match' instead? + (let* ((name (match:prefix (string-match ": " name-and-synopsis))) + (synopsis (match:suffix (string-match ": " name-and-synopsis))) + (version (nodes->text (table-datum summary "Version:"))) + (license ((compose string->license nodes->text) + (table-datum summary "License:"))) + (home-page (nodes->text ((sxpath '((xhtml:a 1))) + (table-datum summary "URL:")))) + (source-url (string-append "mirror://cran/" + ;; Remove double dots, because we want an + ;; absolute path. + (regexp-substitute/global + #f "\\.\\./" + (string-join + ((sxpath '((xhtml:a 1) @ href *text*)) + (table-datum downloads " Package source: "))) Line is too long. + 'pre 'post))) + (tarball (with-store store (download-to-store store source-url))) + (sysdepends (map match:substring + (list-matches + "[^ ]+" + ;; Strip off comma and parenthetical + ;; expressions. + (regexp-substitute/global + #f "(,|\\([^\\)]+\\))" + (nodes->text (table-datum summary "SystemRequirements:")) Line is too long. + 'pre 'post)))) + (imports (map guix-name + ((sxpath '(// xhtml:a *text*)) + (table-datum summary "Imports:"))))) + `(package + (name ,(guix-name name)) + (version ,version) + (source (origin + (method url-fetch) + (uri (string-append ,@(factorize-uri source-url version))) Food for thought: For Ruby, I decided that rather than repeating the same 'string-append' form all over the place, I would have a procedure called 'rubygems-uri' in (guix build-system ruby) that accepts a 'name' and 'version' argument and returns the correct URI. If the source tarballs are all hosted on CRAN, I think this would be a nice thing to add. It can be done later, though. + (sha256 + (base32 + ,(bytevector->nix-base32-string (file-sha256 tarball)))))) + (build-system r-build-system) + ,@(maybe-inputs (append sysdepends imports)) + (home-page ,(if (string-null? home-page) + (string-append %cran-url name) + home-page)) + (synopsis ,synopsis) + ;; Use double spacing + (description ,(regexp-substitute/global #f "\\. \\b" description + 'pre ". " 'post)) + (license ,license))))) + +(define (cran->guix-package package-name) + "Fetch the metadata for PACKAGE-NAME from cran.r-project.org, and return the +`package' s-expression corresponding to that package, or #f on failure." + (let ((module-meta (cran-fetch package-name))) + (and=> module-meta cran-sxml->sexp))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index d0bdec1..9d8e5cb 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "cran")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm new file mode 100644 index 0000000..f11fa10 --- /dev/null +++ b/guix/scripts/import/cran.scm @@ -0,0 +1,92 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Eric Bavier <bav...@member.fsf.org> +;;; Copyright © 2015 Ricardo Wurmus <rek...@elephly.net> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(define-module (guix scripts import cran) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix import cran) + #: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-cran)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (_ "Usage: guix import cran PACKAGE-NAME +Import and convert the CRAN package for PACKAGE-NAME.\n")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -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 cran"))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-cran . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~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 (cran->guix-package package-name))) + (unless sexp + (leave (_ "failed to download description for package '~a'~%") + package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) -- 2.1.0 >From 6b0fcfe408600b3114f88ec430e48acf2a4f1cba Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus <ricardo.wur...@mdc-berlin.de> Date: Fri, 31 Jul 2015 14:47:34 +0200 Subject: [PATCH 2/2] build: Add R build system. * guix/build-system/r.scm: New file. * guix/build/r-build-system: New file. * Makefile.am (MODULES): Add new files. * doc/guix.texi (Build Systems): Document r-build-system. --- Makefile.am | 2 + doc/guix.texi | 9 +++ guix/build-system/r.scm | 134 ++++++++++++++++++++++++++++++++++++++++++ guix/build/r-build-system.scm | 100 +++++++++++++++++++++++++++++++ 4 files changed, 245 insertions(+) create mode 100644 guix/build-system/r.scm create mode 100644 guix/build/r-build-system.scm diff --git a/Makefile.am b/Makefile.am index b397962..af71fae 100644 --- a/Makefile.am +++ b/Makefile.am @@ -58,6 +58,7 @@ MODULES = \ guix/build-system/perl.scm \ guix/build-system/python.scm \ guix/build-system/waf.scm \ + guix/build-system/r.scm \ guix/build-system/ruby.scm \ guix/build-system/trivial.scm \ guix/ftp-client.scm \ @@ -77,6 +78,7 @@ MODULES = \ guix/build/gnu-dist.scm \ guix/build/perl-build-system.scm \ guix/build/python-build-system.scm \ + guix/build/r-build-system.scm \ guix/build/ruby-build-system.scm \ guix/build/waf-build-system.scm \ guix/build/haskell-build-system.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 77e47c0..5a5ef4c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2464,6 +2464,15 @@ passes flags specified by the @code{#:make-maker-flags} or Which Perl package is used can be specified with @code{#:perl}. @end defvr +@defvr {Scheme Variable} r-build-system +This variable is exported by @code{(guix build-system r)}. It +implements the build procedure used by R packages, which essentially is +little more than running @code{R CMD INSTALL +--library=/gnu/store/@dots{}} in an environment where @code{R_LIBS_SITE} +contains the paths to all R package inputs. Tests are run after +installation using the R function @code{tools::testInstalledPackage}. +@end defvr + @defvr {Scheme Variable} ruby-build-system This variable is exported by @code{(guix build-system ruby)}. It implements the RubyGems build procedure used by Ruby packages, which diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm new file mode 100644 index 0000000..4daec5e --- /dev/null +++ b/guix/build-system/r.scm @@ -0,0 +1,134 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ricardo Wurmus <rek...@elephly.net> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(define-module (guix build-system r) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) + #:export (%r-build-system-modules + r-build + r-build-system)) + +;; Commentary: +;; +;; Standard build procedure for R packages. +;; +;; Code: + +(define %r-build-system-modules + ;; Build-side modules imported by default. + `((guix build r-build-system) + ,@%gnu-build-system-modules)) + +(define (default-r) + "Return the default R package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((r-mod (resolve-interface '(gnu packages statistics)))) + (module-ref r-mod 'r))) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (r (default-r)) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + (define private-keywords + '(#:source #:target #:inputs #:native-inputs)) + + (and (not target) ;XXX: no cross-compilation + (bag + (name name) + (system system) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(standard-packages))) + (build-inputs `(("r" ,r) + ,@native-inputs)) + (outputs outputs) + (build r-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define* (r-build store name inputs + #:key + (tests? #t) + (test-target "tests") + (configure-flags ''()) + (phases '(@ (guix build r-build-system) + %standard-phases)) + (outputs '("out")) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %r-build-system-modules) + (modules '((guix build r-build-system) + (guix build utils)))) + "Build SOURCE with INPUTS." + (define builder + `(begin + (use-modules ,@modules) + (r-build #:name ,name + #:source ,(match (assoc-ref inputs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:configure-flags ,configure-flags + #:system ,system + #:tests? ,tests? + #:test-target ,test-target + #:phases ,phases + #:outputs %outputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:inputs %build-inputs))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system #:graft? #f)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages commencement))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system #:graft? #f))))) + + (build-expression->derivation store name builder + #:inputs inputs + #:system system + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build)) + +(define r-build-system + (build-system + (name 'r) + (description "The standard R build system") + (lower lower))) + +;;; r.scm ends here diff --git a/guix/build/r-build-system.scm b/guix/build/r-build-system.scm new file mode 100644 index 0000000..24c806c --- /dev/null +++ b/guix/build/r-build-system.scm @@ -0,0 +1,50 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ricardo Wurmus <rek...@elephly.net> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(define-module (guix build r-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (ice-9 ftw) + #:use-module (ice-9 popen) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (%standard-phases + r-build)) + +;; Commentary: +;; +;; Builder-side code of the standard build procedure for R packages. +;; +;; Code: + +(define (call-r command params) + (zero? (apply system* "R" "CMD" command params))) + +(define (pipe-to-r command params) + (let ((port (apply open-pipe* OPEN_WRITE "R" params))) + (display command port) + (zero? (status:exit-val (close-pipe port))))) + +(define (generate-site-path inputs) + (string-join (map (lambda (input) + (string-append (cdr input) "/site-library")) + ;; Restrict to inputs beginning with "r-". + (filter (lambda (input) + (string-prefix? "r-" (car input))) + inputs)) Use 'match-lambda' instead of car/cdr above. (match-lambda ((_ path) (string-append path "/site-library"))) (match-lambda ((name _) (string-prefix? "r-" name))) + ":")) + +(define* (check #:key test-target inputs outputs tests? #:allow-other-keys) + "Run the test suite of a given R package." + (let* ((libdir (string-append (assoc-ref outputs "out") "/site-library/")) + (pkg-name (car (scandir libdir (negate (cut member <> '("." "..")))))) Ludo prefers that we use 'match' instead of car/cdring. A comment here would help me understand why the package name needs to be determined this way. + (testdir (string-append libdir pkg-name "/" test-target)) + (site-path (string-append libdir ":" (generate-site-path inputs)))) + (if (and tests? (file-exists? testdir)) + (begin + (setenv "R_LIBS_SITE" site-path) + (pipe-to-r (string-append "tools::testInstalledPackage(\"" pkg-name "\", " + "lib.loc = \"" libdir "\")") + (list "--no-save" "--slave"))) Nitpick: Use a quoted list: '("--no-save" "--slave") + #t))) + +(define* (install #:key outputs inputs (configure-flags '()) + #:allow-other-keys) + "Install a given R package." + (let* ((out (assoc-ref outputs "out")) + (site-library (string-append out "/site-library/")) + (params (append configure-flags + (list "--install-tests" + (string-append "--library=" site-library) + "."))) + (site-path (string-append site-library ":" + (generate-site-path inputs)))) + ;; If dependencies cannot be found at install time, R will refuse to + ;; install the package. + (setenv "R_LIBS_SITE" site-path) + ;; Some R packages contain a configure script for which the CONFIG_SHELL + ;; variable should be set. + (setenv "CONFIG_SHELL" (which "bash")) + (mkdir-p site-library) + (call-r "INSTALL" params))) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (delete 'configure) + (delete 'build) + (delete 'check) ; tests must be run after installation + (replace 'install install) + (add-after 'install 'check check))) + +(define* (r-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given R package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) + +;;; r-build-system.scm ends here -- 2.1.0 Looks good overall! - Dave