diff options
| -rw-r--r-- | guix/store.scm | 13 | ||||
| -rw-r--r-- | tests/utils.scm | 7 |
2 files changed, 19 insertions, 1 deletions
diff --git a/guix/store.scm b/guix/store.scm index 5ac98d80bb..0bebe8a564 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -29,6 +29,7 @@ #: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 @@ %store-prefix store-path? - derivation-path?)) + derivation-path? + store-path-package-name)) (define %protocol-version #x10b) @@ -446,3 +448,12 @@ file name. Return #t on success." (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))) diff --git a/tests/utils.scm b/tests/utils.scm index a0b42052ad..7dd248fae2 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -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 @@ (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) |