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

guix: import texlive: Propagate binaries when necessary.

Browse source 
* 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
This commit is contained in:
Nicolas Goaziou 2024-06-01 00:55:01 +02:00 committed by Ludovic Courtès
parent 36c31674bf
commit b4ce7359fb
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 193 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

95
guix/import/texlive.scm
View file

@ -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)))
string<?)))
(tex-formats (formats data))
(meta-package? (null? locs))
(empty-package? (and meta-package? (not (pair? tex-formats)))))
@ -481,16 +517,14 @@ (define (tlpdb->package 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 string<?)))))))
(inputs `((propagated-inputs (list ,@inputs)))))
;; Home page, synopsis, description and license.
(home-page
,(cond
(meta-package? "https://www.tug.org/texlive/")
@ -505,6 +539,7 @@ (define (tlpdb->package 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

130
tests/texlive.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2022 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2023 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2023, 2024 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -162,6 +162,16 @@ (define %fake-tlpdb
"texmf-dist/tex/lollipop/lollipop.ini"
"texmf-dist/tex/lollipop/lollipop.tex")
(catalogue-license . "gpl3"))
("m-tx"
(name . "m-tx")
(shortdesc . "A preprocessor for pmx")
(longdesc . "M-Tx is a preprocessor to pmx")
(depend "m-tx.ARCH")
(runfiles "texmf-dist/scripts/m-tx/m-tx.lua"))
("m-tx.x86_64-linux"
(name . "m-tx.x86_64-linux")
(binfiles "bin/x86_64-linux/m-tx"
"bin/x86_64-linux/prepmx"))
("pax"
(name . "pax")
(shortdesc . "Extract and reinsert PDF...")
@ -329,7 +339,22 @@ (define %fake-tlpdb
"texmf-dist/fonts/tfm/public/trsym/trsy12.tfm"
"texmf-dist/tex/latex/trsym/trsym.sty"
"texmf-dist/tex/latex/trsym/utrsy.fd")
(catalogue-license . "lppl"))))
(catalogue-license . "lppl"))
("vlna"
(name . "vlna")
(shortdesc . "Add ~ after non-syllabic preposition")
(longdesc . "Preprocessor for TeX source")
(depend "vlna.ARCH")
(docfiles "texmf-dist/doc/man/man1/vlna.1"))
("vlna.x86_64-linux"
(shortdesc "x86_64-linux files of vlna")
(binfiles "bin/x86_64-linux/vlna"))
("web"
(depend "web.ARCH")
(docfiles "texmf-dist/doc/man/man1/tangle.1"))
("web.x86_64-linux"
(name . "web.x86_64-linux")
(binfiles "bin/x86_64-linux/tangle"))))
(test-assert "texlive->guix-package, no docfiles"
;; Replace network resources with sample data.
@ -798,4 +823,105 @@ (define %fake-tlpdb
(format #t "~s~%" result)
(pk 'fail result #f)))))))
(test-assert "texlive->guix-package, propagated binaries, no script"
;; Replace network resources with sample data.
(mock ((guix build svn) svn-fetch
(lambda* (url revision directory
#:key (svn-command "svn")
(user-name #f)
(password #f)
(recursive? #t))
(mkdir-p directory)
(with-output-to-file (string-append directory "/foo")
(lambda ()
(display "source")))))
(let ((result (texlive->guix-package "vlna"
#:package-database
(lambda _ %fake-tlpdb))))
(match result
(('package
('name "texlive-vlna")
('version _)
('source _)
('outputs _)
('build-system 'texlive-build-system)
('propagated-inputs
('list 'texlive-vlna-bin))
('home-page _)
('synopsis _)
('description _)
('license _))
#true)
(_
(begin
(format #t "~s~%" result)
(pk 'fail result #f)))))))
(test-assert "texlive->guix-package, propagated binaries and scripts"
;; Replace network resources with sample data.
(mock ((guix build svn) svn-fetch
(lambda* (url revision directory
#:key (svn-command "svn")
(user-name #f)
(password #f)
(recursive? #t))
(mkdir-p directory)
(with-output-to-file (string-append directory "/foo")
(lambda ()
(display "source")))))
(let ((result (texlive->guix-package "m-tx"
#:package-database
(lambda _ %fake-tlpdb))))
(match result
(('package
('name "texlive-m-tx")
('version _)
('source _)
('build-system 'texlive-build-system)
('arguments
('list '#:link-scripts ('gexp ('list "m-tx.lua"))))
('propagated-inputs
('list 'texlive-m-tx-bin))
('home-page _)
('synopsis _)
('description _)
('license _))
#true)
(_
(begin
(format #t "~s~%" result)
(pk 'fail result #f)))))))
(test-assert "texlive->guix-package, with skipped propagated binaries"
;; Replace network resources with sample data.
(mock ((guix build svn) svn-fetch
(lambda* (url revision directory
#:key (svn-command "svn")
(user-name #f)
(password #f)
(recursive? #t))
(mkdir-p directory)
(with-output-to-file (string-append directory "/foo")
(lambda ()
(display "source")))))
(let ((result (texlive->guix-package "web"
#:package-database
(lambda _ %fake-tlpdb))))
(match result
(('package
('name "texlive-web")
('version _)
('source _)
('outputs _)
('build-system 'texlive-build-system)
('home-page _)
('synopsis _)
('description _)
('license _))
#true)
(_
(begin
(format #t "~s~%" result)
(pk 'fail result #f)))))))
(test-end "texlive")