[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/03: import: Replace texlive importer.
|
From: |
guix-commits |
|
Subject: |
02/03: import: Replace texlive importer. |
|
Date: |
Wed, 17 Nov 2021 06:05:08 -0500 (EST) |
rekado pushed a commit to branch master
in repository guix.
commit 3b1a12c5bff5a0c108284d19a6982bdf663bbceb
Author: Ricardo Wurmus <rekado@elephly.net>
AuthorDate: Mon Nov 15 16:38:05 2021 +0000
import: Replace texlive importer.
* guix/import/texlive.scm (fetch-sxml, sxml->package): Remove procedures.
(tlpdb-file, tlpdb, files->directories, tlpdb->package): New procedures.
(string->license): Add case for lpplgpl license combination.
(guix-name): Remove COMPONENT argument.
(texlive->guix-package): Use new procedures.
(texlive-recursive-import): New procedure.
* guix/scripts/import/texlive.scm (show-help, %options): Remove --archive
option.
(guix-import-texlive): Adjust call of texlive->guix-package.
* doc/guix.texi (Invoking guix import): Update documentation.
---
doc/guix.texi | 29 ++---
guix/import/texlive.scm | 254 +++++++++++++++++++++++++---------------
guix/scripts/import/texlive.scm | 16 +--
3 files changed, 170 insertions(+), 129 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 8fdeb93..89a9709 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -30,7 +30,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, 2019, 2020, 2021 Leo Famulari@*
-Copyright @copyright{} 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus@*
+Copyright @copyright{} 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ricardo
Wurmus@*
Copyright @copyright{} 2016 Ben Woodcroft@*
Copyright @copyright{} 2016, 2017, 2018, 2021 Chris Marusich@*
Copyright @copyright{} 2016, 2017, 2018, 2019, 2020, 2021 Efraim Flashner@*
@@ -11875,14 +11875,14 @@ guix import cran --archive=git
https://github.com/immunogenomics/harmony
@item texlive
@cindex TeX Live
@cindex CTAN
-Import metadata from @uref{https://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}.
+Import TeX package information from the TeX Live package database 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.
+Information about the package is obtained from the TeX Live package
+database, a plain text file that is included in the @code{texlive-bin}
+package. The source code is downloaded from possibly multiple locations
+in the SVN repository of the Tex Live project.
The command command below imports metadata for the @code{fontspec}
TeX package:
@@ -11891,19 +11891,6 @@ TeX package:
guix import texlive fontspec
@end example
-When @option{--archive=@var{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 @var{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 json
@cindex JSON, import
Import package metadata from a local JSON file. Consider the following
diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm
index 18d8b95..8677cae 100644
--- a/guix/import/texlive.scm
+++ b/guix/import/texlive.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2021 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -19,18 +19,16 @@
(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 (ice-9 rdelim)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-2)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
- #:use-module (srfi srfi-34)
- #:use-module (web uri)
- #:use-module (guix diagnostics)
- #:use-module (guix i18n)
- #:use-module (guix http-client)
#:use-module (gcrypt hash)
+ #:use-module (guix derivations)
#:use-module (guix memoization)
+ #:use-module (guix monads)
+ #:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix base32)
#:use-module (guix serialization)
@@ -39,24 +37,16 @@
#:use-module (guix utils)
#:use-module (guix upstream)
#:use-module (guix packages)
- #:use-module (gnu packages)
#:use-module (guix build-system texlive)
+ #:use-module (gnu packages tex)
#:export (texlive->guix-package
-
- fetch-sxml
- sxml->package))
+ texlive-recursive-import))
;;; 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.
+;;; Generate a package declaration template for corresponding package in the
+;;; Tex Live Package Database (tlpdb). We fetch all sources from different
+;;; locations in the SVN repository of the Texlive project.
;;;
;;; Code:
@@ -79,6 +69,8 @@
("bsd4" 'bsd-4)
("opl" 'opl1.0+)
("ofl" 'silofl1.1)
+
+ ("lpplgpl" `(list lppl gpl1+))
("lppl" 'lppl)
("lppl1" 'lppl1.0+) ; usually means "or later"
("lppl1.2" 'lppl1.2+) ; usually means "or later"
@@ -107,91 +99,161 @@
("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))))
+ (x `(error unknown-license ,x))))
-(define (guix-name component name)
+(define (guix-name name)
"Return a Guix package name for a given Texlive package NAME."
- (string-append "texlive-" component "-"
+ (string-append "texlive-"
(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)))
+(define (tlpdb-file)
(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 (match ((sxpath '(entry license @ type *text*)) sxml)
- ((license) (string->license license))
- ((lst ...) (map string->license lst))))
- (home-page (string-append "http://www.ctan.org/pkg/"; id))
- (ref (texlive-ref component id))
- (checkout (download-svn-to-store store ref)))
- (unless checkout
- (warning (G_ "Could not determine source location. \
-Please manually specify the source field.~%")))
- `(package
- (name ,(guix-name component id))
- (version ,version)
- (source ,(if checkout
- `(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))))))
- #f))
- (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 ,(match license
- ((lst ...) `(list ,@lst))
- (license license)))))))
+ (run-with-store store
+ (mlet* %store-monad
+ ((drv (lower-object texlive-bin))
+ (built (built-derivations (list drv))))
+ (match (derivation->output-paths drv)
+ (((names . items) ...)
+ (return (string-append (first items)
+ "/share/tlpkg/texlive.tlpdb"))))))))
+
+(define tlpdb
+ (memoize
+ (lambda ()
+ (let ((file (tlpdb-file))
+ (fields
+ '((name . string)
+ (shortdesc . string)
+ (longdesc . string)
+ (catalogue-license . string)
+ (catalogue-ctan . string)
+ (srcfiles . list)
+ (runfiles . list)
+ (docfiles . list)
+ (depend . simple-list)))
+ (record
+ (lambda* (key value alist #:optional (type 'string))
+ (let ((new
+ (or (and=> (assoc-ref alist key)
+ (lambda (existing)
+ (cond
+ ((eq? type 'string)
+ (string-append existing " " value))
+ ((or (eq? type 'list) (eq? type
'simple-list))
+ (cons value existing)))))
+ (cond
+ ((eq? type 'string)
+ value)
+ ((or (eq? type 'list) (eq? type 'simple-list))
+ (list value))))))
+ (acons key new (alist-delete key alist))))))
+ (call-with-input-file file
+ (lambda (port)
+ (let loop ((all (list))
+ (current (list))
+ (last-property #false))
+ (let ((line (read-line port)))
+ (cond
+ ((eof-object? line) all)
+
+ ;; End of record.
+ ((string-null? line)
+ (loop (cons (cons (assoc-ref current 'name) current)
+ all)
+ (list) #false))
+
+ ;; Continuation of a list
+ ((and (zero? (string-index line #\space)) last-property)
+ ;; Erase optional second part of list values like
+ ;; "details=Readme" for files
+ (let ((plain-value (first
+ (string-split
+ (string-trim-both line) #\space))))
+ (loop all (record last-property
+ plain-value
+ current
+ 'list)
+ last-property)))
+ (else
+ (or (and-let* ((space (string-index line #\space))
+ (key (string->symbol (string-take line
space)))
+ (value (string-drop line (1+ space)))
+ (field-type (assoc-ref fields key)))
+ ;; Erase second part of list keys like "size=29"
+ (cond
+ ((eq? field-type 'list)
+ (loop all current key))
+ (else
+ (loop all (record key value current field-type)
key))))
+ (loop all current #false))))))))))))
+
+(define (files->directories files)
+ (pk 'f->d
+ (map (cut string-join <> "/" 'suffix)
+ (delete-duplicates (map (lambda (file)
+ (drop-right (string-split file #\/) 1))
+ files)
+ equal?))))
+
+(define (tlpdb->package name)
+ (and-let* ((data (assoc-ref (tlpdb) name))
+ (dirs (files->directories
+ (map (lambda (dir)
+ (string-drop dir (string-length "texmf-dist/")))
+ (append (or (assoc-ref data 'docfiles) (list))
+ (or (assoc-ref data 'runfiles) (list))
+ (or (assoc-ref data 'srcfiles) (list))))))
+ (name (guix-name name))
+ (version (number->string %texlive-revision))
+ (ref (svn-multi-reference
+ (url (string-append "svn://www.tug.org/texlive/tags/"
+ %texlive-tag "/Master/texmf-dist"))
+ (locations dirs)
+ (revision %texlive-revision)))
+ (source (with-store store
+ (download-multi-svn-to-store
+ store ref (string-append name
"-svn-multi-checkout")))))
+ (values
+ `(package
+ (inherit (simple-texlive-package
+ ,name
+ (list ,@dirs)
+ (base32
+ ,(bytevector->nix-base32-string
+ (let-values (((port get-hash) (open-sha256-port)))
+ (write-file source port)
+ (force-output port)
+ (get-hash))))
+ ,@(if (assoc-ref data 'srcfiles) '() '(#:trivial? #true))))
+ ,@(or (and=> (assoc-ref data 'depend)
+ (lambda (inputs)
+ `((propagated-inputs ,inputs))))
+ '())
+ ,@(or (and=> (assoc-ref data 'catalogue-ctan)
+ (lambda (url)
+ `((home-page ,(string-append "https://ctan.org"; url)))))
+ '((home-page "https://www.tug.org/texlive/";)))
+ (synopsis ,(assoc-ref data 'shortdesc))
+ (description ,(beautify-description
+ (assoc-ref data 'longdesc)))
+ (license ,(string->license
+ (assoc-ref data 'catalogue-license))))
+ (or (assoc-ref data 'depend) (list)))))
(define texlive->guix-package
(memoize
- (lambda* (package-name #:optional (component "latex"))
- "Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
+ (lambda* (name #:key repo version)
+ "Find the metadata for NAME in the tlpdb and return the `package'
s-expression corresponding to that package, or #f on failure."
- (and=> (fetch-sxml package-name)
- (cut sxml->package <> component)))))
+ (tlpdb->package name))))
+
+(define (texlive-recursive-import name)
+ (recursive-import name
+ #:repo->guix-package texlive->guix-package
+ #:guix-name guix-name))
-;;; ctan.scm ends here
+;;; texlive.scm ends here
diff --git a/guix/scripts/import/texlive.scm b/guix/scripts/import/texlive.scm
index 6f0818e..4aeaa79 100644
--- a/guix/scripts/import/texlive.scm
+++ b/guix/scripts/import/texlive.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2021 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
@@ -43,8 +43,6 @@
(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"))
@@ -60,10 +58,6 @@ Import and convert the Texlive package for PACKAGE-NAME.\n"))
(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))
@@ -84,13 +78,11 @@ Import and convert the Texlive package for
PACKAGE-NAME.\n"))
(_ #f))
(reverse opts))))
(match args
- ((package-name)
- (let ((sexp (texlive->guix-package package-name
- (or (assoc-ref opts 'component)
- "latex"))))
+ ((name)
+ (let ((sexp (texlive->guix-package name)))
(unless sexp
(leave (G_ "failed to download description for package '~a'~%")
- package-name))
+ name))
sexp))
(()
(leave (G_ "too few arguments~%")))