420/435: guix: Let texlive importer suggest format creation.

[guix-commits]

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

commit 51340ff2bd9aa3d8d3b4346263346dc1d3e6f278
Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
AuthorDate: Sun Jun 4 13:15:27 2023 +0200

    guix: Let texlive importer suggest format creation.
    
    * guix/import/texlive.scm (tlpdb): Store "execute" entries.
    (tlpdb->package): Add #:CREATE-FORMATS argument when there is an AddFormat
    execute action.
    * tests/texlive.scm (%fake-tlpdb): Add test data.
    ("texlive->guix-package, with TeX format"):
    ("texlive->guix-package, execute but no TeX format"): New tests.
---
 guix/import/texlive.scm |  20 +++++++-
 tests/texlive.scm       | 121 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 140 insertions(+), 1 deletion(-)

diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm
index da58c8d13f..36c6f3efb1 100644
--- a/guix/import/texlive.scm
+++ b/guix/import/texlive.scm
@@ -156,7 +156,8 @@
               (srcfiles . list)
               (runfiles . list)
               (docfiles . list)
-              (depend   . simple-list)))
+              (depend   . simple-list)
+              (execute  . simple-list)))
            (record
             (lambda* (key value alist #:optional (type 'string))
               (let ((new
@@ -319,6 +320,23 @@ of those files are returned that are unexpectedly 
installed."
                 '((outputs '("out" "doc")))
                 '())
           (build-system texlive-build-system)
+          ;; Translate AddFormat execute actions into a `#:create-formats'
+          ;; argument.
+          ,@(or (and-let*
+                    ((actions (assoc-ref data 'execute))
+                     (formats
+                      (delete-duplicates
+                       (filter-map (lambda (action)
+                                     (match (string-split action #\space)
+                                       (("AddFormat" name . _)
+                                        (string-drop name
+                                                     (string-length "name=")))
+                                       (  #f)))
+                                   actions)))
+                     ((not (null? formats))))
+                  `((arguments
+                     (list #:create-formats #~(list ,@(reverse formats))))))
+                '())
           ;; 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))
diff --git a/tests/texlive.scm b/tests/texlive.scm
index 4172262fb2..6633895ae1 100644
--- a/tests/texlive.scm
+++ b/tests/texlive.scm
@@ -50,6 +50,25 @@
         (runfiles
          . ("texmf-dist/tex/latex/12many/12many.sty"))
         (catalogue-license . "lppl")))
+    ("adforn"
+     (name . "adforn")
+     (shortdesc . "OrnementsADF font with TeX/LaTeX support")
+     (longdesc . "The bundle provides the Ornements ADF font...")
+     (execute "addMap OrnementsADF.map")
+     (docfiles
+      "texmf-dist/doc/fonts/adforn/COPYING"
+      "texmf-dist/doc/fonts/adforn/NOTICE"
+      "texmf-dist/doc/fonts/adforn/README"
+      "texmf-dist/doc/fonts/adforn/adforn.pdf")
+     (runfiles
+      "texmf-dist/fonts/afm/arkandis/adforn/OrnementsADF.afm"
+      "texmf-dist/fonts/enc/dvips/adforn/OrnementsADF.enc"
+      "texmf-dist/fonts/map/dvips/adforn/OrnementsADF.map"
+      "texmf-dist/fonts/tfm/arkandis/adforn/OrnementsADF.tfm"
+      "texmf-dist/fonts/type1/arkandis/adforn/OrnementsADF.pfb"
+      "texmf-dist/tex/latex/adforn/adforn.sty"
+      "texmf-dist/tex/latex/adforn/uornementsadf.fd")
+     (catalogue-license . "lppl gpl2"))
     ("chs-physics-report"
      . ((name . "ch-physics-report")
         (shortdesc . "Physics lab reports...")
@@ -75,6 +94,39 @@
          .
          ("texmf-dist/tex/latex/example/example.sty"))
         (catalogue-license . "gpl")))
+    ("lollipop"
+     (name . "lollipop")
+     (shortdesc . "TeX made easy")
+     (longdesc . "Lollipop is TeX made easy...")
+     (execute "AddFormat name=lollipop engine=tex options=\"lollipop.ini\"...")
+     (docfiles
+      "texmf-dist/doc/otherformats/lollipop/README"
+      "texmf-dist/doc/otherformats/lollipop/manual/address.tex"
+      "texmf-dist/doc/otherformats/lollipop/manual/appendix.tex"
+      "texmf-dist/doc/otherformats/lollipop/manual/btxmac.tex"
+      "texmf-dist/doc/otherformats/lollipop/manual/comm.tex"
+      "texmf-dist/doc/otherformats/lollipop/manual/comment.tex"
+      "texmf-dist/doc/otherformats/lollipop/manual/example.tex"
+      "texmf-dist/doc/otherformats/lollipop/manual/extern.tex"
+      "texmf-dist/doc/otherformats/lollipop/manual/head.tex"
+      "texmf-dist/doc/otherformats/lollipop/manual/list.tex"
+      "texmf-dist/doc/otherformats/lollipop/manual/lollipop-manual.bib"
+      "texmf-dist/doc/otherformats/lollipop/manual/lollipop-manual.pdf")
+     (runfiles
+      "texmf-dist/tex/lollipop/lollipop-define.tex"
+      "texmf-dist/tex/lollipop/lollipop-document.tex"
+      "texmf-dist/tex/lollipop/lollipop-float.tex"
+      "texmf-dist/tex/lollipop/lollipop-fontdefs.tex"
+      "texmf-dist/tex/lollipop/lollipop-fonts.tex"
+      "texmf-dist/tex/lollipop/lollipop-heading.tex"
+      "texmf-dist/tex/lollipop/lollipop-lists.tex"
+      "texmf-dist/tex/lollipop/lollipop-output.tex"
+      "texmf-dist/tex/lollipop/lollipop-plain.tex"
+      "texmf-dist/tex/lollipop/lollipop-text.tex"
+      "texmf-dist/tex/lollipop/lollipop-tools.tex"
+      "texmf-dist/tex/lollipop/lollipop.ini"
+      "texmf-dist/tex/lollipop/lollipop.tex")
+     (catalogue-license . "gpl3"))
     ("stricttex"
      . ((name
          . "stricttex")
@@ -440,4 +492,73 @@ completely compatible with Plain TeX.")
                (format #t "~s~%" result)
                (pk 'fail result #f)))))))
 
+(test-assert "texlive->guix-package, with TeX format"
+  ;; 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 "lollipop"
+                                             #:package-database
+                                             (lambda _ %fake-tlpdb))))
+          (match result
+            (('package
+               ('name "texlive-lollipop")
+               ('version _)
+               ('source ('texlive-origin
+                         'name 'version
+                         ('list "doc/otherformats/lollipop/"
+                                "tex/lollipop/")
+                         ('base32 (? string? hash))))
+               ('outputs ''("out" "doc"))
+               ('build-system 'texlive-build-system)
+               ('arguments ('list '#:create-formats ('gexp ('list 
"lollipop"))))
+               ('home-page (? string?))
+               ('synopsis (? string?))
+               ('description (? string?))
+               ('license 'gpl3))
+             #true)
+            (_
+             (begin
+               (format #t "~s~%" result)
+               (pk 'fail result #f)))))))
+
+(test-assert "texlive->guix-package, execute but no TeX format"
+  ;; 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 "adforn"
+                                             #:package-database
+                                             (lambda _ %fake-tlpdb))))
+          (match result
+            (('package
+               ('name "texlive-adforn")
+               ('version _)
+               ('source _)
+               ('outputs ''("out" "doc"))
+               ('build-system 'texlive-build-system)
+               ('home-page (? string?))
+               ('synopsis (? string?))
+               ('description (? string?))
+               ('license _))
+             #true)
+            (_
+             (begin
+               (format #t "~s~%" result)
+               (pk 'fail result #f)))))))
+
 (test-end "texlive")