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

guix: import texlive: Implement auto-updates.

Browse source 
* 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
This commit is contained in:
Nicolas Goaziou 2024-06-16 22:53:14 +02:00 committed by Ludovic Courtès
parent 9dc279e2fd
commit c15b66ac67
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 190 additions and 63 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

71
guix/import/texlive.scm
View file

@ -45,7 +45,8 @@ (define-module (guix import texlive)
#: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 @@ (define no-bin-propagation-packages
"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 @@ (define (tlpdb version)
(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 @@ (define* (texlive-recursive-import name #:key repo 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

142
guix/upstream.scm
View file

@ -28,6 +28,7 @@ (define-module (guix upstream)
#: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 @@ (define-module (guix upstream)
#: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 @@ (define-record-type* <upstream-source>
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 @@ (define ref (upstream-source-urls source)) ; a <git-reference>
#: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 @@ (define* (update-package-source package source hash)
"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,11 +634,41 @@ (define (update-expression expr replacements)
expr
replacements))
(let ((name (package-name package))
(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))
(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))))
@ -635,50 +676,69 @@ (define (update-expression expr replacements)
((? 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))
(_ #f)))
(old-commit (match (origin-uri (package-source package))
((? git-reference? ref)
(git-reference-commit 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)))
(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)))
(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))))
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