From 2d83a25450d4b820c13d52152e5e9f1bbfb5d985 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Sun, 21 Jan 2024 11:05:46 +0100
Subject: [PATCH] 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 d7497e6fb9e3921581f388252f1e18ee9dfabfe2..57a8e86fcb9bff1031c62079aabb6b0da273b97f 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)