diff options
| -rw-r--r-- | guix/import/texlive.scm | 112 | ||||
| -rw-r--r-- | tests/texlive.scm | 39 |
2 files changed, 98 insertions, 53 deletions
diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm index 46680a0b6b..da58c8d13f 100644 --- a/guix/import/texlive.scm +++ b/guix/import/texlive.scm @@ -300,59 +300,65 @@ of those files are returned that are unexpectedly installed." (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 diff --git a/tests/texlive.scm b/tests/texlive.scm index 704c86e24a..4172262fb2 100644 --- a/tests/texlive.scm +++ b/tests/texlive.scm @@ -62,6 +62,11 @@ . ("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 @@ completely compatible with Plain TeX.") (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") |