435/452: guix: texlive importer ignores dependencies unnecessary in Guix.

[guix-commits]

ngz pushed a commit to branch tex-team-next
in repository guix.

commit 802459ba45ac82d34b374e8887e3a688dac421cb
Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
AuthorDate: Tue Jun 6 13:49:00 2023 +0200

    guix: texlive importer ignores dependencies unnecessary in Guix.
    
    * guix/import/texlive.scm (translate-depends): New function.
    (tlpdb->package): Use new function.
    * tests/texlive.scm (%fake-tlpdb): Add test data.
    ("texlive->guix-package, translate dependencies"):
    ("texlive->guix-package, lonely `hyphen-base' dependency and ARCH"): New 
tests.
---
 guix/import/texlive.scm | 45 +++++++++++++++++++--------
 tests/texlive.scm       | 83 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 115 insertions(+), 13 deletions(-)

diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm
index 36c6f3efb1..3b0f5cf5c1 100644
--- a/guix/import/texlive.scm
+++ b/guix/import/texlive.scm
@@ -125,6 +125,33 @@
                                (chr (char-downcase chr)))
                              name)))
 
+(define* (translate-depends depends #:optional texlive-only)
+  "Translate TeX Live packages DEPENDS into their equivalent Guix names
+in `(gnu packages tex)' module, without \"texlive-\" prefix.  The function
+also removes packages not necessary in Guix.
+
+When TEXLIVE-ONLY is true, only TeX Live packages are returned."
+  (delete-duplicates
+   (filter-map (match-lambda
+                 ;; Hyphenation.  Every TeX Live package is replaced with
+                 ;; "hyphen-complete", unless "hyphen-base" is the sole
+                 ;; dependency.
+                 ("hyphen-base"
+                  (and (not (member "hyph-utf8" depends))
+                       "hyphen-base"))
+                 ((or (? (cut string-prefix? "hyphen-" <>))
+                      "hyph-utf8" "dehyph" "dehyph-exptl" "ruhyphen" "ukrhyph")
+                  (and (not texlive-only) "hyphen-complete"))
+                 ;; Binaries placeholders are ignored.
+                 ((? (cut string-suffix? ".ARCH" <>)) #f)
+                 ;; So are TeX Live specific packages.
+                 ((or (? (cut string-prefix? "texlive-" <>))
+                      "tlshell" "texlive.infra")
+                  #f)
+                 ;; Others.
+                 (name name))
+               depends)))
+
 (define (tlpdb-file)
   (define texlive-bin
     ;; Resolve this variable lazily so that (gnu packages ...) does not end up
@@ -293,11 +320,7 @@ of those files are returned that are unexpectedly 
installed."
                    (locations locs)
                    (revision %texlive-revision)))
              ;; Ignore arch-dependent packages.
-             (filtered-depends
-              (or (and=> (assoc-ref data 'depend)
-                         (lambda (inputs)
-                           (remove (cut string-suffix? ".ARCH" <>) inputs)))
-                  '()))
+             (depends (or (assoc-ref data 'depend) '()))
              (source (with-store store
                        (download-multi-svn-to-store
                         store ref (string-append name 
"-svn-multi-checkout")))))
@@ -352,16 +375,12 @@ of those files are returned that are unexpectedly 
installed."
                                  runfiles)))
                   '((native-inputs (list texlive-metafont))))
                 '())
-          ,@(match filtered-depends
+          ,@(match (translate-depends depends)
               (() '())
               (inputs
                `((propagated-inputs
-                  (list ,@(filter-map
-                           (lambda (tex-name)
-                             (let ((name (guix-name tex-name)))
-                               (string->symbol name)))
-                           ;; Sort inputs alphabetically.
-                           (reverse inputs)))))))
+                  (list ,@(map (compose string->symbol guix-name)
+                               (sort inputs string<?)))))))
           (home-page
            ,(cond
              (meta-package? "https://www.tug.org/texlive/";)
@@ -376,7 +395,7 @@ of those files are returned that are unexpectedly 
installed."
               '(license:fsf-free "https://www.tug.org/texlive/copying.html";))
              ((assoc-ref data 'catalogue-license) => string->license)
              (else #f))))
-       filtered-depends))))
+       (translate-depends depends #t)))))
 
 (define texlive->guix-package
   (memoize
diff --git a/tests/texlive.scm b/tests/texlive.scm
index 6633895ae1..975f36c1be 100644
--- a/tests/texlive.scm
+++ b/tests/texlive.scm
@@ -81,6 +81,12 @@
          .
          ("texmf-dist/tex/latex/chs-physics-report/chs-physics-report.sty"))
         (catalogue-license . "pd cc-by-sa-3")))
+    ("collection-basic"
+     (name . "collection-basic")
+     (shortdesc . "Essential programs and files")
+     (longdesc . "These files are regarded as basic...")
+     (depend "amsfonts" "hyph-utf8" "hyphen-base" "texlive-common"
+             "texlive.infra" "tlshell"))
     ("collection-texworks"
      (name . "collection-texworks")
      (shortdesc . "TeXworks editor...")
@@ -146,6 +152,17 @@ stuff like \\newcommand\\pi'12{\\pi '_{12}}.")
          . ("texmf-dist/tex/lualatex/stricttex/stricttex.lua"
             "texmf-dist/tex/lualatex/stricttex/stricttex.sty"))
         (catalogue-license . "lppl1.3c")))
+    ("tex"
+     (name . "tex")
+     (shortdesc . "A sophisticated typesetting engine")
+     (longdesc . "TeX is a typesetting system that incorporates...")
+     (depend "cm" "hyphen-base" "tex.ARCH")
+     (docfiles
+      "texmf-dist/doc/man/man1/initex.1"
+      "texmf-dist/doc/man/man1/initex.man1.pdf"
+      "texmf-dist/doc/man/man1/tex.1"
+      "texmf-dist/doc/man/man1/tex.man1.pdf")
+     (catalogue-license . "knuth"))
     ("texsis"
      . ((name
          . "texsis")
@@ -561,4 +578,70 @@ completely compatible with Plain TeX.")
                (format #t "~s~%" result)
                (pk 'fail result #f)))))))
 
+(test-assert "texlive->guix-package, translate dependencies"
+  ;; 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-basic"
+                                             #:package-database
+                                             (lambda _ %fake-tlpdb))))
+          (match result
+            (('package
+               ('name "texlive-collection-basic")
+               ('version _)
+               ('source _)
+               ('build-system 'texlive-build-system)
+               ('propagated-inputs
+                ('list 'texlive-amsfonts 'texlive-hyphen-complete))
+               ('home-page (? string?))
+               ('synopsis (? string?))
+               ('description (? string?))
+               ('license _))
+             #true)
+            (_
+             (begin
+               (format #t "~s~%" result)
+               (pk 'fail result #f)))))))
+
+(test-assert "texlive->guix-package, lonely `hyphen-base' dependency and ARCH"
+  ;; 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 "tex"
+                                             #:package-database
+                                             (lambda _ %fake-tlpdb))))
+          (match result
+            (('package
+               ('name "texlive-tex")
+               ('version _)
+               ('source _)
+               ('build-system 'texlive-build-system)
+               ('propagated-inputs
+                ('list 'texlive-cm 'texlive-hyphen-base))
+               ('home-page (? string?))
+               ('synopsis (? string?))
+               ('description (? string?))
+               ('license _))
+             #true)
+            (_
+             (begin
+               (format #t "~s~%" result)
+               (pk 'fail result #f)))))))
+
 (test-end "texlive")