me
/
guix
Archived
1
0
Fork 0
Code

packages: Add 'package-upstream-name*'. 

* guix/packages.scm (package-upstream-name*): New procedure.
* tests/packages.scm ("package-upstream-name*"): New test.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Lars-Dominik Braun 2022-12-09 11:46:37 +01:00 committed by Ludovic Courtès
parent a2f0297af0
commit 052faadde7
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 37 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
guix/packages.scm
View File

@ -89,6 +89,7 @@
this-package this-package
package-name package-name
package-upstream-name package-upstream-name
package-upstream-name*
package-version package-version
package-full-name package-full-name
package-source package-source
@ -691,6 +692,38 @@ it has in Guix."
(or (assq-ref (package-properties package) 'upstream-name) (or (assq-ref (package-properties package) 'upstream-name)
(package-name package))) (package-name package)))
(define (package-upstream-name* package)
"Return the upstream name of PACKAGE, accounting for commonly-used
package name prefixes in addition to the @code{upstream-name} property."
(let ((namespaces (list "cl-"
"ecl-"
"emacs-"
"ghc-"
"go-"
"guile-"
"java-"
"julia-"
"lua-"
"minetest-"
"node-"
"ocaml-"
"perl-"
"python-"
"r-"
"ruby-"
"rust-"
"sbcl-"
"texlive-"))
(name (package-name package)))
(or (assq-ref (package-properties package) 'upstream-name)
(let loop ((prefixes namespaces))
(match prefixes
(() name)
((prefix rest ...)
(if (string-prefix? prefix name)
(substring name (string-length prefix))
(loop rest))))))))
(define (hidden-package p) (define (hidden-package p)
"Return a \"hidden\" version of P--i.e., one that 'fold-packages' and thus, "Return a \"hidden\" version of P--i.e., one that 'fold-packages' and thus,
user interfaces, ignores." user interfaces, ignores."

4
tests/packages.scm
View File

@ -626,6 +626,10 @@
(build-derivations %store (list drv)) (build-derivations %store (list drv))
(call-with-input-file output get-string-all))) (call-with-input-file output get-string-all)))
(test-equal "package-upstream-name*"
(package-upstream-name* (specification->package "guile-gcrypt"))
"gcrypt")
;;; ;;;
;;; Source derivation with snippets. ;;; Source derivation with snippets.