ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-23 21:17:11 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix: Add texlive importer.

Browse source 
* 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.
This commit is contained in:
Ricardo Wurmus 2017-06-09 12:35:50 +02:00
parent 9d4f8dc289
commit afbc94194e
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
6 changed files with 435 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile.am
View file

@ -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 \

34
doc/guix.texi
View file

@ -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

182
guix/import/texlive.scm Normal file
View file

@ -0,0 +1,182 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ricardo Wurmus <rekado@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 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

2
guix/scripts/import.scm
View file

@ -74,7 +74,7 @@ (define %standard-import-options '())
;;;
(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem"
"cran" "crate"))
"cran" "crate" "texlive"))
(define (resolve-importer name)
(let ((module (resolve-interface

101
guix/scripts/import/texlive.scm Normal file
View file

@ -0,0 +1,101 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ricardo Wurmus <rekado@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 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~%"))))))

115
tests/texlive.scm Normal file
View file

@ -0,0 +1,115 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ricardo Wurmus <rekado@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 (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
"\
<entry id=\"foo\">
<name>foo</name>
<caption>Foomatic frobnication in LuaLaTeX</caption>
<authorref id=\"rekado\"/>
<license type=\"lppl1.3\"/>
<version number=\"2.6a\"/>
<description>
<p>
Foo is a package for LuaLaTeX. It provides an interface to frobnicate gimbals
in a foomatic way with the LuaTeX engine.
</p>
<p>
The package requires the bar and golly
bundles for extremely special specialties.
</p>
</description>
<ctan path=\"/macros/latex/contrib/foo\" file=\"true\"/>
<texlive location=\"foo\"/>
<keyval key=\"topic\" value=\"tests\"/>
null
</entry>")
(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")