ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

store: Add `store-path-package-name'.

Browse source 
* guix/store.scm (store-path-package-name): New procedure.
* tests/utils.scm ("store-path-package-name"): New test.
This commit is contained in:
Ludovic Courtès 2012-11-01 01:39:23 +01:00
parent 07d18f39cc
commit e3d741065e
2 changed files with 19 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
guix/store.scm
View file

@ -29,6 +29,7 @@ (define-module (guix store)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 regex)
#:export (nix-server? #:export (nix-server?
nix-server-major-version nix-server-major-version
nix-server-minor-version nix-server-minor-version
@ -55,7 +56,8 @@ (define-module (guix store)
%store-prefix %store-prefix
store-path? store-path?
derivation-path?)) derivation-path?
store-path-package-name))
(define %protocol-version #x10b) (define %protocol-version #x10b)
@ -446,3 +448,12 @@ (define (store-path? path)
(define (derivation-path? path) (define (derivation-path? path)
"Return #t if PATH is a derivation path." "Return #t if PATH is a derivation path."
(and (store-path? path) (string-suffix? ".drv" 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)))

7
tests/utils.scm
View file

@ -19,6 +19,7 @@
(define-module (test-utils) (define-module (test-utils)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module ((guix store) #:select (store-path-package-name))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
@ -162,6 +163,12 @@ (define-record-type* <foo> foo make-foo
(match b (($ <foo> 1 2) #t)) (match b (($ <foo> 1 2) #t))
(equal? b c))))) (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) (test-end)