ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-11 13:49:23 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: Replace texlive importer.

Browse source 
* 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.
This commit is contained in:
Ricardo Wurmus 2021-11-15 16:38:05 +00:00
parent 3e5749fc33
commit 3b1a12c5bf
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
3 changed files with 170 additions and 129 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
doc/guix.texi
View file

@ -30,7 +30,7 @@ Copyright @copyright{} 2015, 2016 Mathieu Lirzin@*
Copyright @copyright{} 2014 Pierre-Antoine Rault@* Copyright @copyright{} 2014 Pierre-Antoine Rault@*
Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@* Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@*
Copyright @copyright{} 2015, 2016, 2017, 2019, 2020, 2021 Leo Famulari@* 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 Ben Woodcroft@*
Copyright @copyright{} 2016, 2017, 2018, 2021 Chris Marusich@* Copyright @copyright{} 2016, 2017, 2018, 2021 Chris Marusich@*
Copyright @copyright{} 2016, 2017, 2018, 2019, 2020, 2021 Efraim Flashner@* 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 @item texlive
@cindex TeX Live @cindex TeX Live
@cindex CTAN @cindex CTAN
Import metadata from @uref{https://www.ctan.org/, CTAN}, the Import TeX package information from the TeX Live package database for
comprehensive TeX archive network for TeX packages that are part of the TeX packages that are part of the @uref{https://www.tug.org/texlive/,
@uref{https://www.tug.org/texlive/, TeX Live distribution}. TeX Live distribution}.
Information about the package is obtained through the XML API provided Information about the package is obtained from the TeX Live package
by CTAN, while the source code is downloaded from the SVN repository of database, a plain text file that is included in the @code{texlive-bin}
the Tex Live project. This is done because the CTAN does not keep package. The source code is downloaded from possibly multiple locations
versioned archives. in the SVN repository of the Tex Live project.
The command command below imports metadata for the @code{fontspec} The command command below imports metadata for the @code{fontspec}
TeX package: TeX package:
@ -11891,19 +11891,6 @@ TeX package:
guix import texlive fontspec guix import texlive fontspec
@end example @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 @item json
@cindex JSON, import @cindex JSON, import
Import package metadata from a local JSON file. Consider the following Import package metadata from a local JSON file. Consider the following

254
guix/import/texlive.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -19,18 +19,16 @@
(define-module (guix import texlive) (define-module (guix import texlive)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (sxml simple) #:use-module (ice-9 rdelim)
#:use-module (sxml xpath)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #: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 (gcrypt hash)
#:use-module (guix derivations)
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix monads)
#:use-module (guix gexp)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix serialization) #:use-module (guix serialization)
@ -39,24 +37,16 @@ (define-module (guix import texlive)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix upstream) #:use-module (guix upstream)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (gnu packages)
#:use-module (guix build-system texlive) #:use-module (guix build-system texlive)
#:use-module (gnu packages tex)
#:export (texlive->guix-package #:export (texlive->guix-package
texlive-recursive-import))
fetch-sxml
sxml->package))
;;; Commentary: ;;; Commentary:
;;; ;;;
;;; Generate a package declaration template for the latest version of a ;;; Generate a package declaration template for corresponding package in the
;;; package on CTAN, using the XML output produced by the XML API to the CTAN ;;; Tex Live Package Database (tlpdb). We fetch all sources from different
;;; database at http://www.ctan.org/xml/1.2/ ;;; locations in the SVN repository of the Texlive project.
;;;
;;; 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: ;;; Code:
@ -79,6 +69,8 @@ (define string->license
("bsd4" 'bsd-4) ("bsd4" 'bsd-4)
("opl" 'opl1.0+) ("opl" 'opl1.0+)
("ofl" 'silofl1.1) ("ofl" 'silofl1.1)
("lpplgpl" `(list lppl gpl1+))
("lppl" 'lppl) ("lppl" 'lppl)
("lppl1" 'lppl1.0+) ; usually means "or later" ("lppl1" 'lppl1.0+) ; usually means "or later"
("lppl1.2" 'lppl1.2+) ; usually means "or later" ("lppl1.2" 'lppl1.2+) ; usually means "or later"
@ -107,91 +99,161 @@ (define string->license
("cc-by-nc-nd-4" 'non-free) ("cc-by-nc-nd-4" 'non-free)
((x) (string->license x)) ((x) (string->license x))
((lst ...) `(list ,@(map string->license lst))) ((lst ...) `(list ,@(map string->license lst)))
(_ #f))) (x `(error unknown-license ,x))))
(define (fetch-sxml name) (define (guix-name 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." "Return a Guix package name for a given Texlive package NAME."
(string-append "texlive-" component "-" (string-append "texlive-"
(string-map (match-lambda (string-map (match-lambda
(#\_ #\-) (#\_ #\-)
(#\. #\-) (#\. #\-)
(chr (char-downcase chr))) (chr (char-downcase chr)))
name))) name)))
(define* (sxml->package sxml #:optional (component "latex")) (define (tlpdb-file)
"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 (with-store store
(let* ((id (sxml-value '(entry @ id *text*))) (run-with-store store
(synopsis (sxml-value '(entry caption *text*))) (mlet* %store-monad
(version (or (sxml-value '(entry version @ number *text*)) ((drv (lower-object texlive-bin))
(sxml-value '(entry version @ date *text*)))) (built (built-derivations (list drv))))
(license (match ((sxpath '(entry license @ type *text*)) sxml) (match (derivation->output-paths drv)
((license) (string->license license)) (((names . items) ...)
((lst ...) (map string->license lst)))) (return (string-append (first items)
(home-page (string-append "http://www.ctan.org/pkg/" id)) "/share/tlpkg/texlive.tlpdb"))))))))
(ref (texlive-ref component id))
(checkout (download-svn-to-store store ref))) (define tlpdb
(unless checkout (memoize
(warning (G_ "Could not determine source location. \ (lambda ()
Please manually specify the source field.~%"))) (let ((file (tlpdb-file))
`(package (fields
(name ,(guix-name component id)) '((name . string)
(version ,version) (shortdesc . string)
(source ,(if checkout (longdesc . string)
`(origin (catalogue-license . string)
(method svn-fetch) (catalogue-ctan . string)
(uri (texlive-ref ,component ,id)) (srcfiles . list)
(sha256 (runfiles . list)
(base32 (docfiles . list)
,(bytevector->nix-base32-string (depend . simple-list)))
(let-values (((port get-hash) (open-sha256-port))) (record
(write-file checkout port) (lambda* (key value alist #:optional (type 'string))
(force-output port) (let ((new
(get-hash)))))) (or (and=> (assoc-ref alist key)
#f)) (lambda (existing)
(build-system texlive-build-system) (cond
(arguments ,`(,'quote (#:tex-directory ,(string-join (list component id) "/")))) ((eq? type 'string)
(home-page ,home-page) (string-append existing " " value))
(synopsis ,synopsis) ((or (eq? type 'list) (eq? type 'simple-list))
(description ,(string-trim-both (cons value existing)))))
(string-join (cond
(map string-trim-both ((eq? type 'string)
(string-split value)
(beautify-description ((or (eq? type 'list) (eq? type 'simple-list))
(sxml->string (or (sxml-value '(entry description)) (list value))))))
'()))) (acons key new (alist-delete key alist))))))
#\newline))))) (call-with-input-file file
(license ,(match license (lambda (port)
((lst ...) `(list ,@lst)) (let loop ((all (list))
(license license))))))) (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 (define texlive->guix-package
(memoize (memoize
(lambda* (package-name #:optional (component "latex")) (lambda* (name #:key repo version)
"Fetch the metadata for PACKAGE-NAME from REPO and return the `package' "Find the metadata for NAME in the tlpdb and return the `package'
s-expression corresponding to that package, or #f on failure." s-expression corresponding to that package, or #f on failure."
(and=> (fetch-sxml package-name) (tlpdb->package name))))
(cut sxml->package <> component)))))
;;; ctan.scm ends here (define (texlive-recursive-import name)
(recursive-import name
#:repo->guix-package texlive->guix-package
#:guix-name guix-name))
;;; texlive.scm ends here

16
guix/scripts/import/texlive.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -42,8 +42,6 @@ (define %default-options
(define (show-help) (define (show-help)
(display (G_ "Usage: guix import texlive PACKAGE-NAME (display (G_ "Usage: guix import texlive PACKAGE-NAME
Import and convert the Texlive package for PACKAGE-NAME.\n")) Import and convert the Texlive package for PACKAGE-NAME.\n"))
(display (G_ "
-a, --archive=ARCHIVE specify the archive repository"))
(display (G_ " (display (G_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))
(display (G_ " (display (G_ "
@ -60,10 +58,6 @@ (define %options
(option '(#\V "version") #f #f (option '(#\V "version") #f #f
(lambda args (lambda args
(show-version-and-exit "guix import texlive"))) (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)) %standard-import-options))
@ -84,13 +78,11 @@ (define (parse-options)
(_ #f)) (_ #f))
(reverse opts)))) (reverse opts))))
(match args (match args
((package-name) ((name)
(let ((sexp (texlive->guix-package package-name (let ((sexp (texlive->guix-package name)))
(or (assoc-ref opts 'component)
"latex"))))
(unless sexp (unless sexp
(leave (G_ "failed to download description for package '~a'~%") (leave (G_ "failed to download description for package '~a'~%")
package-name)) name))
sexp)) sexp))
(() (()
(leave (G_ "too few arguments~%"))) (leave (G_ "too few arguments~%")))