mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
store: Add `store-path-package-name'.
* guix/store.scm (store-path-package-name): New procedure. * tests/utils.scm ("store-path-package-name"): New test.
This commit is contained in:
parent
07d18f39cc
commit
e3d741065e
2 changed files with 19 additions and 1 deletions
|
@ -29,6 +29,7 @@ (define-module (guix store)
|
|||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (ice-9 regex)
|
||||
#:export (nix-server?
|
||||
nix-server-major-version
|
||||
nix-server-minor-version
|
||||
|
@ -55,7 +56,8 @@ (define-module (guix store)
|
|||
|
||||
%store-prefix
|
||||
store-path?
|
||||
derivation-path?))
|
||||
derivation-path?
|
||||
store-path-package-name))
|
||||
|
||||
(define %protocol-version #x10b)
|
||||
|
||||
|
@ -446,3 +448,12 @@ (define (store-path? path)
|
|||
(define (derivation-path? path)
|
||||
"Return #t if PATH is a derivation path."
|
||||
(and (store-path? path) (string-suffix? ".drv" path)))
|
||||
|
||||
(define (store-path-package-name path)
|
||||
"Return the package name part of PATH, a file name in the store."
|
||||
(define store-path-rx
|
||||
(make-regexp (string-append "^.*" (regexp-quote (%store-prefix))
|
||||
"/[^-]+-(.+)$")))
|
||||
|
||||
(and=> (regexp-exec store-path-rx path)
|
||||
(cut match:substring <> 1)))
|
||||
|
|
|
@ -19,6 +19,7 @@
|
|||
|
||||
(define-module (test-utils)
|
||||
#:use-module (guix utils)
|
||||
#:use-module ((guix store) #:select (store-path-package-name))
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
|
@ -162,6 +163,12 @@ (define-record-type* <foo> foo make-foo
|
|||
(match b (($ <foo> 1 2) #t))
|
||||
(equal? b c)))))
|
||||
|
||||
;; This is actually in (guix store).
|
||||
(test-equal "store-path-package-name"
|
||||
"bash-4.2-p24"
|
||||
(store-path-package-name
|
||||
"/nix/store/qvs2rj2ia5vci3wsdb7qvydrmacig4pg-bash-4.2-p24"))
|
||||
|
||||
(test-end)
|
||||
|
||||
|
||||
|
|
Loading…
Reference in a new issue