me/guix
Archived
1
0
Fork 0
Code Activity

guix: import: Improve importing texlive meta packages.

Browse source 
* guix/import/texlive.scm (tlpdb->package): Generate more appropriate source,
home page and license fields when importing meta packages, i.e., TeX Live
collections and schemes.
* tests/texlive.scm (%fake-tlpdb): Add test data.
("texlive->guix-package, meta-package"): New test.
This commit is contained in:
Nicolas Goaziou 2023-05-27 21:39:26 +02:00
parent 293abb4c4e
commit d62b35bbe9
No known key found for this signature in database
GPG key ID: DA00B4F048E92F2D
2 changed files with 98 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

112
guix/import/texlive.scm
View file

@ -300,59 +300,65 @@ of those files are returned that are unexpectedly installed."
(source (with-store store (source (with-store store
(download-multi-svn-to-store (download-multi-svn-to-store
store ref (string-append name "-svn-multi-checkout"))))) store ref (string-append name "-svn-multi-checkout")))))
(values (let ((meta-package? (null? locs)))
`(package (values
(name ,name) `(package
(version (number->string %texlive-revision)) (name ,name)
(source (texlive-origin (version (number->string %texlive-revision))
name version (source ,(and (not meta-package?)
(list ,@(sort locs string<)) `(texlive-origin
(base32 name version
,(bytevector->nix-base32-string (list ,@(sort locs string<))
(let-values (((port get-hash) (open-sha256-port))) (base32
(write-file source port) ,(bytevector->nix-base32-string
(force-output port) (let-values (((port get-hash) (open-sha256-port)))
(get-hash)))))) (write-file source port)
,@(if (assoc-ref data 'docfiles) (force-output port)
'((outputs '("out" "doc"))) (get-hash)))))))
'()) ,@(if (assoc-ref data 'docfiles)
(build-system texlive-build-system) '((outputs '("out" "doc")))
;; Texlive build system generates font metrics whenever a font metrics '())
;; file has the same base name as a Metafont file. (build-system texlive-build-system)
,@(or (and-let* ((runfiles (assoc-ref data 'runfiles)) ;; Texlive build system generates font metrics whenever a font
(metrics ;; metrics file has the same base name as a Metafont file.
(filter-map (lambda (f) ,@(or (and-let* ((runfiles (assoc-ref data 'runfiles))
(and (string-suffix? ".tfm" f) (metrics
(basename f ".tfm"))) (filter-map (lambda (f)
runfiles)) (and (string-suffix? ".tfm" f)
((not (null? metrics))) (basename f ".tfm")))
((any (lambda (f) runfiles))
(and (string-suffix? ".mf" f) ((not (null? metrics)))
(member (basename f ".mf") metrics))) ((any (lambda (f)
runfiles))) (and (string-suffix? ".mf" f)
'((native-inputs (list texlive-metafont)))) (member (basename f ".mf") metrics)))
'()) runfiles)))
,@(match filtered-depends '((native-inputs (list texlive-metafont))))
(() '()) '())
(inputs ,@(match filtered-depends
`((propagated-inputs (() '())
(list ,@(map (inputs
(lambda (tex-name) `((propagated-inputs
(let ((name (guix-name tex-name))) (list ,@(filter-map
(string->symbol name))) (lambda (tex-name)
;; Sort inputs alphabetically. (let ((name (guix-name tex-name)))
(reverse inputs))))))) (string->symbol name)))
(home-page ;; Sort inputs alphabetically.
,(or (and=> (or (assoc-ref data 'catalogue) (reverse inputs)))))))
(assoc-ref data 'name)) (home-page
(lambda (name) ,(cond
(string-append "https://ctan.org/pkg/" name))) (meta-package? "https://www.tug.org/texlive/")
"https://www.tug.org/texlive/")) ((or (assoc-ref data 'catalogue) (assoc-ref data 'name)) =>
(synopsis ,(assoc-ref data 'shortdesc)) (cut string-append "https://ctan.org/pkg/" <>))
(description ,(and=> (assoc-ref data 'longdesc) beautify-description)) (else "https://www.tug.org/texlive/")))
(license ,(and=> (assoc-ref data 'catalogue-license) (synopsis ,(assoc-ref data 'shortdesc))
string->license))) (description ,(and=> (assoc-ref data 'longdesc) beautify-description))
filtered-depends))) (license
,(cond
(meta-package?
'(license:fsf-free "https://www.tug.org/texlive/copying.html"))
((assoc-ref data 'catalogue-license) => string->license)
(else #f))))
filtered-depends))))
(define texlive->guix-package (define texlive->guix-package
(memoize (memoize

39
tests/texlive.scm
View file

@ -62,6 +62,11 @@
. .
("texmf-dist/tex/latex/chs-physics-report/chs-physics-report.sty")) ("texmf-dist/tex/latex/chs-physics-report/chs-physics-report.sty"))
(catalogue-license . "pd cc-by-sa-3"))) (catalogue-license . "pd cc-by-sa-3")))
("collection-texworks"
(name . "collection-texworks")
(shortdesc . "TeXworks editor...")
(longdesc . "See http...")
(depend "texworks" "collection-basic"))
("example" ("example"
. ((name . "example") . ((name . "example")
(shortdesc . "Typeset examples...") (shortdesc . "Typeset examples...")
@ -401,4 +406,38 @@ completely compatible with Plain TeX.")
(format #t "~s~%" result) (format #t "~s~%" result)
(pk 'fail result #f))))))) (pk 'fail result #f)))))))
(test-assert "texlive->guix-package, meta-package"
;; 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 "collection-texworks"
#:package-database
(lambda _ %fake-tlpdb))))
(match result
(('package
('name "texlive-collection-texworks")
('version _)
('source #f)
('build-system 'texlive-build-system)
('propagated-inputs
('list 'texlive-collection-basic 'texlive-texworks))
('home-page "https://www.tug.org/texlive/")
('synopsis (? string?))
('description (? string?))
('license
('license:fsf-free "https://www.tug.org/texlive/copying.html")))
#true)
(_
(begin
(format #t "~s~%" result)
(pk 'fail result #f)))))))
(test-end "texlive") (test-end "texlive")