From e786293e769f4d69e14d77905bf3a5745557033f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 17 Oct 2014 20:58:02 +0200
Subject: [PATCH] derivations: Add 'derivation-name'.

* guix/derivations.scm (derivation-name): New procedure.
* tests/derivations.scm ("derivation-name"): New test.
---
 guix/derivations.scm  | 6 ++++++
 tests/derivations.scm | 5 +++++
 2 files changed, 11 insertions(+)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index b80e31936e..b2a5c6b976 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -56,6 +56,7 @@
             derivation-input-sub-derivations
             derivation-input-output-paths
 
+            derivation-name
             fixed-output-derivation?
             offloadable-derivation?
             substitutable-derivation?
@@ -128,6 +129,11 @@
                                           (derivation-outputs drv)))
                                     (number->string (object-address drv) 16))))
 
+(define (derivation-name drv)
+  "Return the base name of DRV."
+  (let ((base (store-path-package-name (derivation-file-name drv))))
+    (string-drop-right base 4)))
+
 (define (fixed-output-derivation? drv)
   "Return #t if DRV is a fixed-output derivation, such as the result of a
 download with a fixed hash (aka. `fetchurl')."
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 29b341e2bb..4b36758c25 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -173,6 +173,11 @@
                 (= (stat:ino (lstat file1))
                    (stat:ino (lstat file2))))))))
 
+(test-equal "derivation-name"
+  "foo-0.0"
+  (let ((drv (derivation %store "foo-0.0" %bash '())))
+    (derivation-name drv)))
+
 (test-assert "offloadable-derivation?"
   (and (offloadable-derivation? (derivation %store "foo" %bash '()))
        (not (offloadable-derivation?