From afbc94194e223378dd3aece6e2330015e5e57a1e Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 9 Jun 2017 12:35:50 +0200 Subject: [PATCH] guix: Add texlive importer. * guix/import/texlive.scm: New file. * guix/scripts/import/texlive.scm: New file. * Makefile.am (MODULES): Add them. * tests/texlive.scm: New file. * Makefile.am (SCM_TESTS): Add it. * guix/scripts/import.scm (importers): Add texlive importer. * doc/guix.texi (Invoking guix import): Document it. --- Makefile.am | 3 + doc/guix.texi | 34 +++++- guix/import/texlive.scm | 182 ++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/texlive.scm | 101 ++++++++++++++++++ tests/texlive.scm | 115 ++++++++++++++++++++ 6 files changed, 435 insertions(+), 2 deletions(-) create mode 100644 guix/import/texlive.scm create mode 100644 guix/scripts/import/texlive.scm create mode 100644 tests/texlive.scm diff --git a/Makefile.am b/Makefile.am index 436a003411..4dfcd06d0b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -145,6 +145,7 @@ MODULES = \ guix/import/cran.scm \ guix/import/hackage.scm \ guix/import/elpa.scm \ + guix/import/texlive.scm \ guix/scripts.scm \ guix/scripts/download.scm \ guix/scripts/perform-download.scm \ @@ -167,6 +168,7 @@ MODULES = \ guix/scripts/import/nix.scm \ guix/scripts/import/hackage.scm \ guix/scripts/import/elpa.scm \ + guix/scripts/import/texlive.scm \ guix/scripts/environment.scm \ guix/scripts/publish.scm \ guix/scripts/edit.scm \ @@ -303,6 +305,7 @@ SCM_TESTS = \ tests/hackage.scm \ tests/cran.scm \ tests/elpa.scm \ + tests/texlive.scm \ tests/store.scm \ tests/monads.scm \ tests/gexp.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 056059d04b..97fa1b7864 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -21,7 +21,7 @@ Copyright @copyright{} 2015, 2016 Mathieu Lirzin@* Copyright @copyright{} 2014 Pierre-Antoine Rault@* Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@* Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@* -Copyright @copyright{} 2015, 2016 Ricardo Wurmus@* +Copyright @copyright{} 2015, 2016, 2017 Ricardo Wurmus@* Copyright @copyright{} 2016 Ben Woodcroft@* Copyright @copyright{} 2016 Chris Marusich@* Copyright @copyright{} 2016, 2017 Efraim Flashner@* @@ -5671,6 +5671,38 @@ R package: guix import cran --archive=bioconductor GenomicRanges @end example +@item texlive +@cindex TeX Live +@cindex CTAN +Import metadata from @uref{http://www.ctan.org/, CTAN}, the +comprehensive TeX archive network for TeX packages that are part of the +@uref{https://www.tug.org/texlive/, TeX Live distribution}. + +Information about the package is obtained through the XML API provided +by CTAN, while the source code is downloaded from the SVN repository of +the Tex Live project. This is done because the CTAN does not keep +versioned archives. + +The command command below imports metadata for the @code{fontspec} +TeX package: + +@example +guix import texlive fontspec +@end example + +When @code{--archive=DIRECTORY} is added, the source code is downloaded +not from the @file{latex} sub-directory of the @file{texmf-dist/source} +tree in the TeX Live SVN repository, but from the specified sibling +directory under the same root. + +The command below imports metadata for the @code{ifxetex} package from +CTAN while fetching the sources from the directory +@file{texmf/source/generic}: + +@example +guix import texlive --archive=generic ifxetex +@end example + @item nix Import metadata from a local copy of the source of the @uref{http://nixos.org/nixpkgs/, Nixpkgs distribution}@footnote{This diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm new file mode 100644 index 0000000000..d4c3714364 --- /dev/null +++ b/guix/import/texlive.scm @@ -0,0 +1,182 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ricardo Wurmus +;;; +;;; 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 texlive) + #:use-module (ice-9 match) + #:use-module (sxml simple) + #:use-module (sxml xpath) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (web uri) + #:use-module (guix http-client) + #:use-module (guix hash) + #:use-module (guix memoization) + #:use-module (guix store) + #:use-module (guix base32) + #:use-module (guix serialization) + #:use-module (guix svn-download) + #:use-module (guix import utils) + #:use-module (guix utils) + #:use-module (guix upstream) + #:use-module (guix packages) + #:use-module (gnu packages) + #:use-module (guix build-system texlive) + #:export (texlive->guix-package)) + +;;; Commentary: +;;; +;;; Generate a package declaration template for the latest version of a +;;; package on CTAN, using the XML output produced by the XML API to the CTAN +;;; database at http://www.ctan.org/xml/1.2/ +;;; +;;; Instead of taking the packages from CTAN, however, we fetch the sources +;;; from the SVN repository of the Texlive project. We do this because CTAN +;;; only keeps a single version of each package whereas we can access any +;;; version via SVN. Unfortunately, this means that the importer is really +;;; just a Texlive importer, not a generic CTAN importer. +;;; +;;; Code: + +(define string->license + (match-lambda + ("artistic2" 'gpl3+) + ("gpl" 'gpl3+) + ("gpl1" 'gpl1) + ("gpl1+" 'gpl1+) + ("gpl2" 'gpl2) + ("gpl2+" 'gpl2+) + ("gpl3" 'gpl3) + ("gpl3+" 'gpl3+) + ("lgpl2.1" 'lgpl2.1) + ("lgpl3" 'lgpl3) + ("knuth" 'knuth) + ("pd" 'public-domain) + ("bsd2" 'bsd-2) + ("bsd3" 'bsd-3) + ("bsd4" 'bsd-4) + ("opl" 'opl1.0+) + ("ofl" 'silofl1.1) + ("lppl" 'lppl) + ("lppl1" 'lppl1.0+) ; usually means "or later" + ("lppl1.2" 'lppl1.2+) ; usually means "or later" + ("lppl1.3" 'lppl1.3+) ; usually means "or later" + ("lppl1.3a" 'lppl1.3a) + ("lppl1.3b" 'lppl1.3b) + ("lppl1.3c" 'lppl1.3c) + ("cc-by-2" 'cc-by-2.0) + ("cc-by-3" 'cc-by-3.0) + ("cc-by-sa-2" 'cc-by-sa2.0) + ("cc-by-sa-3" 'cc-by-sa3.0) + ("mit" 'expat) + ("fdl" 'fdl1.3+) + ("gfl" 'gfl1.0) + + ;; These are known non-free licenses + ("noinfo" 'unknown) + ("nosell" 'non-free) + ("shareware" 'non-free) + ("nosource" 'non-free) + ("nocommercial" 'non-free) + ("cc-by-nc-nd-1" 'non-free) + ("cc-by-nc-nd-2" 'non-free) + ("cc-by-nc-nd-2.5" 'non-free) + ("cc-by-nc-nd-3" 'non-free) + ("cc-by-nc-nd-4" 'non-free) + ((x) (string->license x)) + ((lst ...) `(list ,@(map string->license lst))) + (_ #f))) + +(define (fetch-sxml name) + "Return an sxml representation of the package information contained in the +XML description of the CTAN package or #f in case of failure." + ;; This API always returns the latest release of the module. + (let ((url (string-append "http://www.ctan.org/xml/1.2/pkg/" name))) + (guard (c ((http-get-error? c) + (format (current-error-port) + "error: failed to retrieve package information \ +from ~s: ~a (~s)~%" + (uri->string (http-get-error-uri c)) + (http-get-error-code c) + (http-get-error-reason c)) + #f)) + (xml->sxml (http-fetch url) + #:trim-whitespace? #t)))) + +(define (guix-name component name) + "Return a Guix package name for a given Texlive package NAME." + (string-append "texlive-" component "-" + (string-map (match-lambda + (#\_ #\-) + (#\. #\-) + (chr (char-downcase chr))) + name))) + +(define* (sxml->package sxml #:optional (component "latex")) + "Return the `package' s-expression for a Texlive package from the SXML +expression describing it." + (define (sxml-value path) + (match ((sxpath path) sxml) + (() #f) + ((val) val))) + (with-store store + (let* ((id (sxml-value '(entry @ id *text*))) + (synopsis (sxml-value '(entry caption *text*))) + (version (or (sxml-value '(entry version @ number *text*)) + (sxml-value '(entry version @ date *text*)))) + (license (string->license (sxml-value '(entry license @ type *text*)))) + (home-page (string-append "http://www.ctan.org/pkg/" id)) + (ref (texlive-ref component id)) + (checkout (download-svn-to-store store ref))) + `(package + (name ,(guix-name component id)) + (version ,version) + (source (origin + (method svn-fetch) + (uri (texlive-ref ,component ,id)) + (sha256 + (base32 + ,(bytevector->nix-base32-string + (let-values (((port get-hash) (open-sha256-port))) + (write-file checkout port) + (force-output port) + (get-hash))))))) + (build-system texlive-build-system) + (arguments ,`(,'quote (#:tex-directory ,(string-join (list component id) "/")))) + (home-page ,home-page) + (synopsis ,synopsis) + (description ,(string-trim-both + (string-join + (map string-trim-both + (string-split + (beautify-description + (sxml->string (or (sxml-value '(entry description)) + '()))) + #\newline))))) + (license ,license))))) + +(define texlive->guix-package + (memoize + (lambda* (package-name #:optional (component "latex")) + "Fetch the metadata for PACKAGE-NAME from REPO and return the `package' +s-expression corresponding to that package, or #f on failure." + (and=> (fetch-sxml package-name) + (cut sxml->package <> component))))) + +;;; ctan.scm ends here diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 203cda8049..9bba074e8c 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -74,7 +74,7 @@ rather than \\n." ;;; (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem" - "cran" "crate")) + "cran" "crate" "texlive")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/texlive.scm b/guix/scripts/import/texlive.scm new file mode 100644 index 0000000000..1cceee7051 --- /dev/null +++ b/guix/scripts/import/texlive.scm @@ -0,0 +1,101 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ricardo Wurmus +;;; +;;; 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 texlive) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import texlive) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (srfi srfi-41) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-texlive)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (G_ "Usage: guix import texlive PACKAGE-NAME +Import and convert the Texlive package for PACKAGE-NAME.\n")) + (display (G_ " + -a, --archive=ARCHIVE specify the archive repository")) + (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 texlive"))) + (option '(#\a "archive") #t #f + (lambda (opt name arg result) + (alist-cons 'component arg + (alist-delete 'component result)))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-texlive . 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 (texlive->guix-package package-name + (or (assoc-ref opts 'component) + "latex")))) + (unless sexp + (leave (G_ "failed to download description for package '~a'~%") + package-name)) + sexp)) + (() + (leave (G_ "too few arguments~%"))) + ((many ...) + (leave (G_ "too many arguments~%")))))) diff --git a/tests/texlive.scm b/tests/texlive.scm new file mode 100644 index 0000000000..e28eda175c --- /dev/null +++ b/tests/texlive.scm @@ -0,0 +1,115 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ricardo Wurmus +;;; +;;; 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 (test-texlive) + #:use-module (gnu packages tex) + #:use-module (guix import texlive) + #:use-module (guix tests) + #:use-module (guix build utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match)) + +(test-begin "texlive") + +(define xml + "\ + + foo + Foomatic frobnication in LuaLaTeX + + + + +

+ Foo is a package for LuaLaTeX. It provides an interface to frobnicate gimbals + in a foomatic way with the LuaTeX engine. +

+

+ The package requires the bar and golly + bundles for extremely special specialties. +

+ + + + + null +") + +(define sxml + '(*TOP* (entry (@ (id "foo")) + (name "foo") + (caption "Foomatic frobnication in LuaLaTeX") + (authorref (@ (id "rekado"))) + (license (@ (type "lppl1.3"))) + (version (@ (number "2.6a"))) + (description + (p "\n Foo is a package for LuaLaTeX. It provides an interface to frobnicate gimbals\n in a foomatic way with the LuaTeX engine.\n ") + (p "\n The package requires the bar and golly\n bundles for extremely special specialties.\n ")) + (ctan (@ (path "/macros/latex/contrib/foo") (file "true"))) + (texlive (@ (location "foo"))) + (keyval (@ (value "tests") (key "topic"))) + "\n null\n"))) + +(test-equal "fetch-sxml: returns SXML for valid XML" + sxml + (mock ((guix http-client) http-fetch + (lambda (url) + xml)) + ((@@ (guix import texlive) fetch-sxml) "foo"))) + +;; TODO: +(test-assert "sxml->package" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result ((@@ (guix import texlive) sxml->package) sxml))) + (match result + (('package + ('name "texlive-latex-foo") + ('version "2.6a") + ('source ('origin + ('method 'svn-fetch) + ('uri ('texlive-ref "latex" "foo")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'texlive-build-system) + ('arguments ('quote (#:tex-directory "latex/foo"))) + ('home-page "http://www.ctan.org/pkg/foo") + ('synopsis "Foomatic frobnication in LuaLaTeX") + ('description + "Foo is a package for LuaLaTeX. It provides an interface to \ +frobnicate gimbals in a foomatic way with the LuaTeX engine. The package \ +requires the bar and golly bundles for extremely special specialties.") + ('license 'lppl1.3+)) + #t) + (_ + (begin + (format #t "~s\n" result) + (pk 'fail result #f))))))) + +(test-end "texlive")