02/02: hydra: build-package-metadata: Produce ‘variable_name’ field when possible.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository maintenance.

commit 58bd4453c8f5cc969fe50d515b414bd4586a906f
Author: Ludovic Courtès <ludovic.courtes@inria.fr>
AuthorDate: Mon Oct 9 14:26:10 2023 +0200

    hydra: build-package-metadata: Produce ‘variable_name’ field when possible.
    
    * hydra/build-package-metadata.scm (package-variable-name): New procedure.
    (package->json): Use it to produce ‘variable_name’ field.
---
 hydra/build-package-metadata.scm | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/hydra/build-package-metadata.scm b/hydra/build-package-metadata.scm
index 44a3c84..0a75204 100755
--- a/hydra/build-package-metadata.scm
+++ b/hydra/build-package-metadata.scm
@@ -34,6 +34,7 @@
              ((guix base64) #:select (base64-encode))
              ((guix describe) #:select (current-profile))
              ((guix config) #:select (%guix-version))
+             ((guix modules) #:select (file-name->module-name))
              (guix download)
              (guix git-download)
              (guix svn-download)
@@ -41,6 +42,7 @@
              (json)
              (zlib)
              (web uri)
+             ((ice-9 control) #:select (let/ec))
              (ice-9 match)
              (ice-9 vlist)
              (srfi srfi-1)
@@ -192,14 +194,32 @@ superseded packages."
                `(("hg_changeset" . ,(hg-reference-changeset uri)))
                '())))))
 
+(define (package-variable-name package)
+  "Return the name of the variable whose value is PACKAGE in the module that
+defines it, or #f if this could not be determined."
+  (match (package-location package)
+    (#f #f)
+    ((= location-file file)
+     (let* ((name (file-name->module-name file))
+            (module (false-if-exception (resolve-interface name))))
+       (let/ec return
+         (module-for-each (lambda (symbol variable)
+                            (when (eq? package (variable-ref variable))
+                              (return symbol)))
+                          module)
+         #f)))))
+
 (define (package->json package)
   (define cpe-name
     (assoc-ref (package-properties package) 'cpe-name))
   (define cpe-version
     (assoc-ref (package-properties package) 'cpe-version))
+  (define variable
+    (package-variable-name package))
 
   `(("name"     . ,(package-name package))
     ("version"  . ,(package-version package))
+    ,@(if variable `(("variable_name" . ,variable)) '())
     ,@(if cpe-name `(("cpe_name" . ,cpe-name)) '())
     ,@(if cpe-version `(("cpe_version" . ,cpe-version)) '())
     ,@(if (origin? (package-source package))