02/02: import/cran: Generate rudimentary ARGUMENTS field.

[guix-commits]

rekado pushed a commit to branch master
in repository guix.

commit 2d83a25450d4b820c13d52152e5e9f1bbfb5d985
Author: Ricardo Wurmus <rekado@elephly.net>
AuthorDate: Sun Jan 21 11:05:46 2024 +0100

    import/cran: Generate rudimentary ARGUMENTS field.
    
    * guix/import/cran.scm (phases-for-inputs, maybe-arguments): New procedures.
    (description->package): Splice in result of MAYBE-ARGUMENTS.
    
    Change-Id: I578e1903f37c91bf865f0be49b04187ec372ed05
---
 guix/import/cran.scm | 48 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 47 insertions(+), 1 deletion(-)

diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index d7497e6fb9..57a8e86fcb 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -672,6 +672,52 @@ of META, a package in REPOSITORY."
             (string<? (upstream-input-downstream-name input1)
                       (upstream-input-downstream-name input2))))))
 
+(define (phases-for-inputs input-names)
+  "Generate a list of build phases based on the provided INPUT-NAMES, a list
+of package names for all input packages."
+  (let ((rules
+         (list (lambda ()
+                 (and (member "styler" input-names)
+                      '(add-after 'unpack 'set-HOME
+                         (lambda _ (setenv "HOME" "/tmp")))))
+               (lambda ()
+                 (and (member "esbuild" input-names)
+                      '(add-after 'unpack 'process-javascript
+                         (lambda* (#:key inputs #:allow-other-keys)
+                           (with-directory-excursion "inst/"
+                             (for-each (match-lambda
+                                         ((source . target)
+                                          (minify source #:target target)))
+                                       '())))))))))
+    (fold (lambda (rule phases)
+            (let ((new-phase (rule)))
+              (if new-phase (cons new-phase phases) phases)))
+          (list)
+          rules)))
+
+(define (maybe-arguments inputs)
+  "Generate a list for the arguments field that can be spliced into a package
+S-expression."
+  (let ((input-names (map upstream-input-name inputs))
+        (esbuild-modules '(#:modules
+                           '((guix build r-build-system)
+                             (guix build minify-build-system)
+                             (guix build utils)
+                             (ice-9 match))
+                           #:imported-modules
+                           `(,@%r-build-system-modules
+                             (guix build minify-build-system)))))
+    (match (phases-for-inputs input-names)
+      (() '())
+      (phases
+       `((arguments
+          (list
+           ,@(if (member "esbuild" input-names)
+                 esbuild-modules '())
+           #:phases
+           '(modify-phases %standard-phases
+              ,@phases))))))))
+
 (define* (description->package repository meta #:key (license-prefix identity)
                                (download-source download))
   "Return the `package' s-expression for an R package published on REPOSITORY
@@ -751,7 +797,7 @@ from the alist META, which was derived from the R package's 
DESCRIPTION file."
                     `((properties ,`(,'quasiquote ((,'upstream-name . 
,name)))))
                     '())
               (build-system r-build-system)
-
+              ,@(maybe-arguments inputs)
               ,@(maybe-inputs (filter (upstream-input-type-predicate 'regular)
                                       inputs)
                               'inputs)