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.
This commit is contained in:
parent
1123fd81ce
commit
58bd4453c8
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue