From 2530a12c3a676cf28fcc9c2293bef1d18ea8af3a Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 1 Jun 2024 00:55:01 +0200 Subject: guix: import texlive: Propagate binaries when necessary. * guix/import/texlive.scm (no-bin-propagation-packages): New variable. (list-binfiles): New function. (linked-scripts): Renamed to... (list-linked-scripts): ... this. Now always return a list. (tlpdb->package): Handle binary propagation. * tests/texlive.scm (%fake-tlpdb): Add data for new tests. ("texlive->guix-package, propagated binaries, no script"): ("texlive->guix-package, propagated binaries and scripts"): ("texlive->guix-package, with skipped propagated binaries"): New tests. Change-Id: I707ba33a10aa98ad27151724d3ecc4158db6b7cc --- guix/import/texlive.scm | 95 +++++++++++++++++++++++++++++++++---------------- 1 file changed, 65 insertions(+), 30 deletions(-) (limited to 'guix/import/texlive.scm') diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm index 7e79c77884..20dedc9114 100644 --- a/guix/import/texlive.scm +++ b/guix/import/texlive.scm @@ -64,6 +64,23 @@ (define texlive-generic-locations "tex/generic/hyphen/" "web2c/")) +;; The following packages should propagate their binaries according to the TeX +;; Live database, but won't because said binaries are already provided by +;; "texlive-bin". As a consequence, the importer does not make them propagate +;; their "-bin" counterpart. +(define no-bin-propagation-packages + (list "cweb" + "latex-bin" + "luahbtex" + "luatex" + "metafont" + "pdftex" + "pdftosrc" + "synctex" + "tex" + "tie" + "web")) + (define string->license (match-lambda ("artistic2" 'artistic2.0) @@ -296,33 +313,39 @@ (define (formats package-data) ;; Get the right (alphabetic) order. (reverse actions)))))) -(define (linked-scripts name package-database) +(define (list-binfiles name package-database) + "Return the list of \"binfiles\", i.e., files meant to be installed in +\"bin/\" directory, for package NAME according to PACKAGE-DATABASE." + (or (and-let* ((data (assoc-ref package-database name)) + (depend (assoc-ref data 'depend)) + ((member (string-append name ".ARCH") depend)) + (bin-data (assoc-ref package-database + ;; Any *nix-like architecture will do. + (string-append name ".x86_64-linux")))) + (map basename (assoc-ref bin-data 'binfiles))) + '())) + +(define (list-linked-scripts name package-database) "Return a list of script names to symlink from \"bin/\" directory for package NAME according to PACKAGE-DATABASE. Consider as scripts files with \".lua\", \".pl\", \".py\", \".rb\", \".sh\", \".tcl\", \".texlua\", \".tlu\" extensions, and files without extension." - (and-let* ((data (assoc-ref package-database name)) - ;; Check if binaries are associated to the package. - (depend (assoc-ref data 'depend)) - ((member (string-append name ".ARCH") depend)) - ;; List those binaries. - (bin-data (assoc-ref package-database - ;; Any *nix-like architecture will do. - (string-append name ".x86_64-linux"))) - (binaries (map basename (assoc-ref bin-data 'binfiles))) - ;; List scripts candidates. Bail out if there are none. - (runfiles (assoc-ref data 'runfiles)) - (scripts (filter (cut string-prefix? "texmf-dist/scripts/" <>) - runfiles)) - ((pair? scripts))) - (filter-map (lambda (script) - (and (any (lambda (ext) - (member (basename script ext) binaries)) - '(".lua" ".pl" ".py" ".rb" ".sh" ".tcl" ".texlua" - ".tlu")) - (basename script))) - ;; Get the right (alphabetic) order. - (reverse scripts)))) + (or (and-let* ((data (assoc-ref package-database name)) + ;; List scripts candidates. Bail out if there are none. + (runfiles (assoc-ref data 'runfiles)) + (scripts (filter (cut string-prefix? "texmf-dist/scripts/" <>) + runfiles)) + ((pair? scripts)) + (binfiles (list-binfiles name package-database))) + (filter-map (lambda (script) + (and (any (lambda (ext) + (member (basename script ext) binfiles)) + '(".lua" ".pl" ".py" ".rb" ".sh" ".tcl" ".texlua" + ".tlu")) + (basename script))) + ;; Get the right (alphabetic) order. + (reverse scripts))) + '())) (define* (files-differ? directory package-name #:key @@ -408,7 +431,20 @@ (define (tlpdb->package name version package-database) (source (with-store store (download-multi-svn-to-store store ref (string-append name "-svn-multi-checkout"))))) - (let* ((scripts (linked-scripts texlive-name package-database)) + (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 (translate-depends depends))) + stringpackage name version package-database) ((string-suffix? ".rb" s) '(ruby)) ((string-suffix? ".tcl" s) '(tcl tk)) (else '()))) - (or scripts '())) + scripts) (() '()) (inputs `((inputs (list ,@(delete-duplicates inputs eq?)))))) ;; Propagated inputs. - ,@(match (translate-depends depends) + ,@(match (map string->symbol propagated-inputs) (() '()) - (inputs - `((propagated-inputs - (list ,@(map (compose string->symbol guix-name) - (sort inputs stringpackage name version package-database) '(fsf-free "https://www.tug.org/texlive/copying.html")) ((assoc-ref data 'catalogue-license) => string->license) (else #f)))) + ;; List of pure TeX Live dependencies for recursive calls. (translate-depends depends #t))))) (define texlive->guix-package -- cgit v1.2.3