ngz pushed a commit to branch tex-team
in repository guix.
commit f21d2af50d848c193cd019c2668df82154bc88bb
Author: Nicolas Goaziou <m...@nicolasgoaziou.fr>
AuthorDate: Sun Jun 16 20:30:32 2024 +0200
guix: import texlive: Factorize package inputs listing.
* guix/import/texlive.scm (list-upstream-inputs):
(upstream-inputs->texlive-inputs): New functions.
(tlpdb->package): Use new functions.
Use <upstream-input> record to store associated inputs.
Change-Id: I70d42d291347feaade36eef83a04218fb100aae9
---
guix/import/texlive.scm | 122 ++++++++++++++++++++++++++++++++----------------
1 file changed, 81 insertions(+), 41 deletions(-)
diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm
index 7cf8d41cc4..0e0369a416 100644
--- a/guix/import/texlive.scm
+++ b/guix/import/texlive.scm
@@ -30,6 +30,7 @@
#:use-module (guix serialization)
#:use-module (guix store)
#:use-module (guix svn-download)
+ #:use-module (guix upstream)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
@@ -345,6 +346,79 @@ extensions, and files without extension."
(reverse scripts)))
'()))
+(define (list-upstream-inputs upstream-name)
+ "Return the list of <upstream-input> corresponding to all the dependencies
+of package with UPSTREAM-NAME."
+ (let* ((database (tlpdb))
+ (package-data (assoc-ref database upstream-name))
+ (scripts (list-linked-scripts upstream-name database)))
+ (append
+ ;; Native inputs.
+ ;;
+ ;; Texlive build system generates font metrics whenever a font metrics
+ ;; file has the same base name as a Metafont file. In this case, provide
+ ;; TEXLIVE-METAFONT.
+ (or (and-let* ((runfiles (assoc-ref package-data 'runfiles))
+ (metrics
+ (filter-map (lambda (f)
+ (and (string-suffix? ".tfm" f)
+ (basename f ".tfm")))
+ runfiles))
+ ((not (null? metrics)))
+ ((any (lambda (f)
+ (and (string-suffix? ".mf" f)
+ (member (basename f ".mf") metrics)))
+ runfiles)))
+ (list (upstream-input
+ (name "metafont")
+ (downstream-name "texlive-metafont")
+ (type 'native))))
+ '())
+ ;; Regular inputs.
+ ;;
+ ;; Those may be required by scripts associated to the package.
+ (match (append-map (lambda (s)
+ (cond ((string-suffix? ".pl" s) '("perl"))
+ ((string-suffix? ".py" s) '("python"))
+ ((string-suffix? ".rb" s) '("ruby"))
+ ((string-suffix? ".tcl" s) '("tcl" "tk"))
+ (else '())))
+ scripts)
+ (() '())
+ (inputs (map (lambda (input-name)
+ (upstream-input
+ (name input-name)
+ (downstream-name input-name)
+ (type 'regular)))
+ (delete-duplicates inputs string=))))
+ ;; Propagated inputs.
+ ;;
+ ;; Return the "depend" references given in the TeX Live database. Also
+ ;; check if the package has associated binaries built from
+ ;; TEXLIVE-SOURCE. In that case, add a Guix-specific NAME-bin propagated
+ ;; input.
+ (let ((binfiles (list-binfiles upstream-name database)))
+ (map (lambda (input-name)
+ (upstream-input
+ (name input-name)
+ (downstream-name (guix-name input-name))
+ (type 'propagated)))
+ (sort (append
+ (filter-depends (or (assoc-ref package-data 'depend) '()))
+ ;; Check if propagation of binaries is necessary. It
+ ;; happens when binfiles outnumber the scripts, if any.
+ (if (and (> (length binfiles) (length scripts))
+ (not (member upstream-name
+ no-bin-propagation-packages)))
+ (list (string-append upstream-name "-bin"))
+ '()))
+ string<?))))))
+
+(define (upstream-inputs->texlive-inputs upstream-inputs type)
+ (map (compose string->symbol upstream-input-downstream-name)
+ (filter (upstream-input-type-predicate type)
+ upstream-inputs)))
+
(define (files->locations files)
(define (trim-filename entry)
(string-join (drop-right (string-split entry #\/) 1) "/" 'suffix))
@@ -392,19 +466,7 @@ extensions, and files without extension."
(download-multi-svn-to-store
store ref (string-append name
"-svn-multi-checkout")))))
(let* ((scripts (list-linked-scripts texlive-name package-database))
- (propagated-inputs
- (let ((binfiles (list-binfiles texlive-name package-database)))
- (sort (append
- ;; Check if propagation of binaries is necessary. It
- ;; happens when binfiles outnumber the scripts, if any.
- (if (and (> (length binfiles) (length scripts))
- (not (member texlive-name
- no-bin-propagation-packages)))
- (list (string-append name "-bin"))
- '())
- ;; Regular dependencies, as specified in database.
- (map guix-name (filter-depends depends)))
- string<?)))
+ (upstream-inputs (list-upstream-inputs texlive-name))
(tex-formats (list-formats data))
(meta-package? (null? locs))
(empty-package? (and meta-package? (not (pair? tex-formats)))))
@@ -452,36 +514,14 @@ extensions, and files without extension."
(if (pair? arguments)
`((arguments (list ,@arguments)))
'()))
- ;; Native inputs.
- ;;
- ;; Texlive build system generates font metrics whenever a font
- ;; metrics file has the same base name as a Metafont file. In this
- ;; case, provide `texlive-metafont'.
- ,@(or (and-let* ((runfiles (assoc-ref data 'runfiles))
- (metrics
- (filter-map (lambda (f)
- (and (string-suffix? ".tfm" f)
- (basename f ".tfm")))
- runfiles))
- ((not (null? metrics)))
- ((any (lambda (f)
- (and (string-suffix? ".mf" f)
- (member (basename f ".mf") metrics)))
- runfiles)))
- '((native-inputs (list texlive-metafont))))
- '())
;; Inputs.
- ,@(match (append-map (lambda (s)
- (cond ((string-suffix? ".pl" s) '(perl))
- ((string-suffix? ".py" s) '(python))
- ((string-suffix? ".rb" s) '(ruby))
- ((string-suffix? ".tcl" s) '(tcl tk))
- (else '())))
- scripts)
+ ,@(match (upstream-inputs->texlive-inputs upstream-inputs 'native)
+ (() '())
+ (inputs `((native-inputs (list ,@inputs)))))
+ ,@(match (upstream-inputs->texlive-inputs upstream-inputs 'regular)
(() '())
- (inputs `((inputs (list ,@(delete-duplicates inputs eq?))))))
- ;; Propagated inputs.
- ,@(match (map string->symbol propagated-inputs)
+ (inputs `((inputs (list ,@inputs)))))
+ ,@(match (upstream-inputs->texlive-inputs upstream-inputs 'regular)
(() '())
(inputs `((propagated-inputs (list ,@inputs)))))
;; Home page, synopsis, description and license.
