ngz pushed a commit to branch tex-team
in repository guix.
commit a2362def9df31cd6fdf72b031563c9f7c9014d04
Author: Nicolas Goaziou <m...@nicolasgoaziou.fr>
AuthorDate: Sun Jun 16 22:53:14 2024 +0200
guix: import texlive: Implement auto-updates.
* guix/import/texlive.scm (package-from-texlive-repository?):
(latest-release):
(tlpdb-guix-packages):
(%texlive-updater): New variables.
(tlpdb): Include Guix-specific package TEXLIVE-HYPHEN-COMPLETE.
* guix/upstream.scm (package-update/svn-multi-fetch): New variable.
(%method-updates): Extend it to support SVN-MULTI-FETCH.
(update-package-source): Also update revisions and locations from
svn-multi-reference sources.
Change-Id: I6d7f2cfe1e2f78887f410233bfd2799ffab80f3c
---
guix/import/texlive.scm | 71 ++++++++++++++++++-
guix/upstream.scm | 182 ++++++++++++++++++++++++++++++++----------------
2 files changed, 190 insertions(+), 63 deletions(-)
diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm
index cbccafb811..b743495008 100644
--- a/guix/import/texlive.scm
+++ b/guix/import/texlive.scm
@@ -45,7 +45,8 @@
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:export (texlive->guix-package
- texlive-recursive-import))
+ texlive-recursive-import
+ %texlive-updater))
;;; Commentary:
;;;
@@ -102,6 +103,42 @@
"tie"
"web"))
+;; Guix introduces two specific packages based on TEXLIVE-BUILD-SYSTEM. Add
+;; an entry for them in the package database, so they can be imported, and
+;; updated, like any other regular TeX Live package.
+(define tlpdb-guix-packages
+ '(("hyphen-complete"
+ (docfiles "texmf-dist/doc/generic/dehyph-exptl/"
+ "texmf-dist/doc/generic/elhyphen/"
+ "texmf-dist/doc/generic/huhyphen/"
+ "texmf-dist/doc/generic/hyph-utf8/"
+ "texmf-dist/doc/luatex/hyph-utf8/"
+ "texmf-dist/doc/generic/ukrhyph/")
+ (runfiles "texmf-dist/tex/generic/config/"
+ "texmf-dist/tex/generic/dehyph/"
+ "texmf-dist/tex/generic/dehyph-exptl/"
+ "texmf-dist/tex/generic/hyph-utf8/"
+ "texmf-dist/tex/generic/hyphen/"
+ "texmf-dist/tex/generic/ruhyphen/"
+ "texmf-dist/tex/generic/ukrhyph/"
+ "texmf-dist/tex/luatex/hyph-utf8/")
+ (srcfiles "texmf-dist/source/generic/hyph-utf8/"
+ "texmf-dist/source/luatex/hyph-utf8/"
+ "texmf-dist/source/generic/ruhyphen/")
+ (shortdesc . "Hyphenation patterns expressed in UTF-8")
+ (longdesc . "Modern native UTF-8 engines such as XeTeX and LuaTeX
+need hyphenation patterns in UTF-8 format, whereas older systems require
+hyphenation patterns in the 8-bit encoding of the font in use (such encodings
+are codified in the LaTeX scheme with names like OT1, T2A, TS1, OML, LY1,
+etc). The present package offers a collection of conversions of existing
+patterns to UTF-8 format, together with converters for use with 8-bit fonts in
+older systems.
+
+This Guix-specific package provides hyphenation patterns for all languages
+supported in TeX Live. It is a strict super-set of code{hyphen-base} package
+and should be preferred to it whenever a package would otherwise depend on
+@code{hyph-utf8}."))))
+
(define (svn-command . args)
"Execute \"svn\" command with arguments ARGS, provided as strings, and
return its output as a string. Raise an error if the command execution did
@@ -301,7 +338,8 @@ association list."
(last-property #false))
(let ((line (read-line port)))
(cond
- ((eof-object? line) (values all))
+ ;; End of file. Don't forget to include Guix-specific package.
+ ((eof-object? line) (values (append tlpdb-guix-packages all)))
;; End of record.
((string-null? line)
@@ -617,4 +655,33 @@ VERSION."
#:repo->guix-package texlive->guix-package
#:guix-name guix-name))
+;;;
+;;; Updates.
+;;;
+
+(define (package-from-texlive-repository? package)
+ (and (string-prefix? "texlive-" (package-name package))
+ (eq? 'texlive (build-system-name (package-build-system package)))))
+
+(define* (latest-release package #:key version)
+ "Return an <upstream-source> for the latest release of PACKAGE. Optionally
+include a VERSION string to fetch a specific version."
+ (let* ((version (or version (latest-texlive-tag)))
+ (database (tlpdb/cached version))
+ (upstream-name (package-upstream-name* package)))
+ (upstream-source
+ (package upstream-name)
+ (version version)
+ (urls (texlive->svn-multi-reference upstream-name version database))
+ (inputs (list-upstream-inputs upstream-name version database)))))
+
+(define %texlive-updater
+ ;; The TeX Live updater. It is restricted to TeX Live releases (2023.0,
+ ;; 2024.2, ...); it doesn't include revision bumps for individual packages.
+ (upstream-updater
+ (name 'texlive)
+ (description "Updater for TeX Live packages")
+ (pred package-from-texlive-repository?)
+ (import latest-release)))
+
;;; texlive.scm ends here
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 180ae21dcf..753916be64 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -28,6 +28,7 @@
#:use-module ((guix download)
#:select (download-to-store url-fetch))
#:use-module (guix git-download)
+ #:use-module (guix svn-download)
#:use-module (guix gnupg)
#:use-module (guix packages)
#:use-module (guix diagnostics)
@@ -49,6 +50,7 @@
#:use-module (srfi srfi-35)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
#:export (upstream-source
upstream-source?
upstream-source-package
@@ -107,7 +109,7 @@
upstream-source?
(package upstream-source-package) ;string
(version upstream-source-version) ;string
- (urls upstream-source-urls) ;list of
strings|git-reference
+ (urls upstream-source-urls) ;list of strings|git-references...
(signature-urls upstream-source-signature-urls ;#f | list of strings
(default #f))
(inputs upstream-source-inputs ;#f | list of <upstream-input>
@@ -463,10 +465,19 @@ SOURCE, an <upstream-source>."
#:recursive? (git-reference-recursive? ref))
source))
+(define* (package-update/svn-multi-fetch store package source
+ #:key key-download key-server)
+ "Return the version, checkout, and SOURCE, to update PACKAGE to
+SOURCE, an <upstream-source>."
+ (values (upstream-source-version source)
+ (download-multi-svn-to-store store (upstream-source-urls source))
+ source))
+
(define %method-updates
;; Mapping of origin methods to source update procedures.
`((,url-fetch . ,package-update/url-fetch)
- (,git-fetch . ,package-update/git-fetch)))
+ (,git-fetch . ,package-update/git-fetch)
+ (,svn-multi-fetch . ,package-update/svn-multi-fetch)))
(define* (package-update store package
#:optional (updaters (force %updaters))
@@ -608,9 +619,9 @@ specified in SOURCE, an <upstream-source>."
"Modify the source file that defines PACKAGE to refer to SOURCE, an
<upstream-source> whose tarball has SHA256 HASH (a bytevector). Return the
new version string if an update was made, and #f otherwise."
- (define (update-expression expr replacements)
+ (define (replace-atom expr replacements)
;; Apply REPLACEMENTS to package expression EXPR, a string. REPLACEMENTS
- ;; must be a list of replacement pairs, either bytevectors or strings.
+ ;; must be a list of replacement pairs, either of byte-vectors or strings.
(fold (lambda (replacement str)
(match replacement
(((? bytevector? old-bv) . (? bytevector? new-bv))
@@ -623,62 +634,111 @@ new version string if an update was made, and #f
otherwise."
expr
replacements))
- (let ((name (package-name package))
- (version (upstream-source-version source))
- (version-loc (package-field-location package 'version)))
- (if version-loc
- (let* ((loc (package-location package))
- (old-version (package-version package))
- (old-hash (content-hash-value
- (origin-hash (package-source package))))
- (old-url (match (origin-uri (package-source package))
- ((? string? url) url)
- ((? git-reference? ref)
- (git-reference-url ref))
- (_ #f)))
- (new-url (match (upstream-source-urls source)
- ((first _ ...) first)
- ((? git-reference? ref)
- (git-reference-url ref))
- (_ #f)))
- (old-commit (match (origin-uri (package-source package))
- ((? git-reference? ref)
- (git-reference-commit ref))
- (_ #f)))
- (new-commit (match (upstream-source-urls source)
- ((? git-reference? ref)
- (git-reference-commit ref))
- (_ #f)))
- (file (and=> (location-file loc)
- (cut search-path %load-path <>))))
- (if file
- ;; Be sure to use absolute filename. Replace the URL directory
- ;; when OLD-URL is available; this is useful notably for
- ;; mirror://cpan/ URLs where the directory may change as a
- ;; function of the person who uploads the package. Note that
- ;; package definitions usually concatenate fragments of the URL,
- ;; which is why we only attempt to replace a subset of the URL.
- (let ((replacements `((,old-version . ,version)
- (,old-hash . ,hash)
- ,@(if (and old-commit new-commit)
- `((,old-commit . ,new-commit))
- '())
- ,@(if (and old-url new-url)
- `((,(dirname old-url) .
- ,(dirname new-url)))
- '()))))
- (and (edit-expression (location->source-properties
- (absolute-location loc))
- (cut update-expression <> replacements))
- (or (not (upstream-source-inputs source))
- (update-package-inputs package source))
- version))
- (begin
- (warning (G_ "~a: could not locate source file")
- (location-file loc))
- #f)))
- (warning (package-location package)
- (G_ "~a: no `version' field in source; skipping~%")
- name))))
+ (define (replace-commit old new expr)
+ ;; Replace OLD commit or revision with NEW commit or revision in package
+ ;; expression EXPR. Special care is given to ensure the commit or
+ ;; revision does not inadvertently match a part of a bigger item.
+ (let ((regexp (make-regexp (format #f " ~s($|[ )])" old)
+ regexp/newline)))
+ (regexp-substitute/global
+ #f regexp expr 'pre (lambda (m) (format #f " ~s" new)) 1 'post)))
+
+ (define (replace-list old new expr)
+ ;; Replace list OLD with list NEW in package expression EXPR. Elements in
+ ;; NEW are aligned vertically, at the same column as the first element in
+ ;; OLD.
+ (if (equal? old new)
+ expr
+ (let ((regexp
+ (make-regexp
+ (string-append
+ "(^[^\"]*)" ;initial indentation in group 1
+ (string-join (map (compose regexp-quote object->string) old)
+ "[ \t\n]*"))
+ regexp/newline))
+ (f
+ (lambda (m)
+ (let* ((lead (match:substring m 1))
+ (indent (make-string (string-length lead) #\space)))
+ (string-append
+ lead
+ (string-join (map object->string new)
+ (string-append "\n" indent)))))))
+ (regexp-substitute/global #f regexp expr 'pre f 'post))))
+
+ (let* ((name (package-name package))
+ (loc (package-location package))
+ (version (upstream-source-version source))
+ (old-version (package-version package))
+ (old-hash (content-hash-value
+ (origin-hash (package-source package))))
+ (old-url (match (origin-uri (package-source package))
+ ((? string? url) url)
+ ((? git-reference? ref)
+ (git-reference-url ref))
+ ((? svn-multi-reference? ref)
+ (svn-multi-reference-url ref))
+ (_ #f)))
+ (old-commit (match (origin-uri (package-source package))
+ ((? git-reference? ref)
+ (git-reference-commit ref))
+ ((? svn-multi-reference? ref)
+ (svn-multi-reference-revision ref))
+ (_ #f)))
+ (old-locations (match (origin-uri (package-source package))
+ ((? svn-multi-reference? ref)
+ (svn-multi-reference-locations ref))
+ (_ #f)))
+ (new-url (match (upstream-source-urls source)
+ ((first _ ...) first)
+ ((? git-reference? ref)
+ (git-reference-url ref))
+ ((? svn-multi-reference? ref)
+ (svn-multi-reference-url ref))
+ (_ #f)))
+ (new-commit (match (upstream-source-urls source)
+ ((? git-reference? ref)
+ (git-reference-commit ref))
+ ((? svn-multi-reference? ref)
+ (svn-multi-reference-revision ref))
+ (_ #f)))
+ (new-locations (match (upstream-source-urls source)
+ ((? svn-multi-reference? ref)
+ (svn-multi-reference-locations ref))
+ (_ #f))))
+ (cond
+ ;; Ensure package exists, has a version field, and is stored in a file
+ ;; with an absolute file name.
+ ((not (package-field-location package 'version))
+ (warning (package-location package)
+ (G_ "~a: no `version' field in source; skipping~%")
+ name))
+ ((not (and=> (location-file loc)
+ (cut search-path %load-path <>)))
+ (warning (G_ "~a: could not locate source file")
+ (location-file loc))
+ #f)
+ ;; Proceed with replacements.
+ (else
+ (let ((replacement-pairs
+ `((,old-version . ,version)
+ (,old-hash . ,hash)
+ ;; Replace the URL directory when OLD-URL is available; this is
+ ;; useful notably for mirror://cpan/ URLs where the directory
+ ;; may change as a function of the person who uploads the
+ ;; package. Note that package definitions usually concatenate
+ ;; fragments of the URL, which is why we only attempt to
+ ;; replace a subset of the URL.
+ ,@(if (and old-url new-url)
+ `((,(dirname old-url) . ,(dirname new-url)))
+ '()))))
+ (and (edit-expression
+ (location->source-properties (absolute-location loc))
+ (compose (cut replace-atom <> replacement-pairs)
+ (cut replace-commit old-commit new-commit <>)
+ (cut replace-list old-locations new-locations <>)))
+ (or (not (upstream-source-inputs source))
+ (update-package-inputs package source))
+ version))))))
;;; upstream.scm ends here
