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: 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 @@ (define (tlpdb->package name version package-database)
(source (with-store store
(download-multi-svn-to-store
store ref (string-append name "-svn-multi-checkout")))))
(values
`(package
(name ,name)
(version (number->string %texlive-revision))
(source (texlive-origin
name version
(list ,@(sort locs string<))
(base32
,(bytevector->nix-base32-string
(let-values (((port get-hash) (open-sha256-port)))
(write-file source port)
(force-output port)
(get-hash))))))
,@(if (assoc-ref data 'docfiles)
'((outputs '("out" "doc")))
'())
(build-system texlive-build-system)
;; Texlive build system generates font metrics whenever a font metrics
;; file has the same base name as a Metafont file.
,@(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))))
'())
,@(match filtered-depends
(() '())
(inputs
`((propagated-inputs
(list ,@(map
(lambda (tex-name)
(let ((name (guix-name tex-name)))
(string->symbol name)))
;; Sort inputs alphabetically.
(reverse inputs)))))))
(home-page
,(or (and=> (or (assoc-ref data 'catalogue)
(assoc-ref data 'name))
(lambda (name)
(string-append "https://ctan.org/pkg/" name)))
"https://www.tug.org/texlive/"))
(synopsis ,(assoc-ref data 'shortdesc))
(description ,(and=> (assoc-ref data 'longdesc) beautify-description))
(license ,(and=> (assoc-ref data 'catalogue-license)
string->license)))
filtered-depends)))
(let ((meta-package? (null? locs)))
(values
`(package
(name ,name)
(version (number->string %texlive-revision))
(source ,(and (not meta-package?)
`(texlive-origin
name version
(list ,@(sort locs string<))
(base32
,(bytevector->nix-base32-string
(let-values (((port get-hash) (open-sha256-port)))
(write-file source port)
(force-output port)
(get-hash)))))))
,@(if (assoc-ref data 'docfiles)
'((outputs '("out" "doc")))
'())
(build-system texlive-build-system)
;; Texlive build system generates font metrics whenever a font
;; metrics file has the same base name as a Metafont file.
,@(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))))
'())
,@(match filtered-depends
(() '())
(inputs
`((propagated-inputs
(list ,@(filter-map
(lambda (tex-name)
(let ((name (guix-name tex-name)))
(string->symbol name)))
;; Sort inputs alphabetically.
(reverse inputs)))))))
(home-page
,(cond
(meta-package? "https://www.tug.org/texlive/")
((or (assoc-ref data 'catalogue) (assoc-ref data 'name)) =>
(cut string-append "https://ctan.org/pkg/" <>))
(else "https://www.tug.org/texlive/")))
(synopsis ,(assoc-ref data 'shortdesc))
(description ,(and=> (assoc-ref data 'longdesc) beautify-description))
(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
(memoize

39
tests/texlive.scm
View file

@ -62,6 +62,11 @@ (define %fake-tlpdb
.
("texmf-dist/tex/latex/chs-physics-report/chs-physics-report.sty"))
(catalogue-license . "pd cc-by-sa-3")))
("collection-texworks"
(name . "collection-texworks")
(shortdesc . "TeXworks editor...")
(longdesc . "See http...")
(depend "texworks" "collection-basic"))
("example"
. ((name . "example")
(shortdesc . "Typeset examples...")
@ -401,4 +406,38 @@ (define %fake-tlpdb
(format #t "~s~%" result)
(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")