summary refs log tree commit diff
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2021-06-14 10:08:49 +0200
committerMathieu Othacehe <othacehe@gnu.org>2021-06-14 10:08:49 +0200
commitc13ad2b889f54350d78ce993b79f1bea0043c3d8 (patch)
tree6536a1aeb5609a0fc7fe3f8ee29b079521c1dae3
parent7546a1d3c0a354ca7dc0b7e53c1505130c2d263d (diff)
downloadguix-c13ad2b889f54350d78ce993b79f1bea0043c3d8.tar.gz
ci: Backport package-channels procedure.
* gnu/ci.scm (package-channels): New procedure.
-rw-r--r--gnu/ci.scm21
1 files changed, 21 insertions, 0 deletions
diff --git a/gnu/ci.scm b/gnu/ci.scm
index 5a068167ae..f452da95f5 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -109,6 +109,27 @@ does not have the expected structure."
 
     (_ #f)))
 
+;; Backport from (guix describe) module.
+(define (package-channels package)
+  "Return the list of channels providing PACKAGE or an empty list if it could
+not be determined."
+  (match (and=> (package-location package) location-file)
+    (#f '())
+    (file
+     (let ((file (if (string-prefix? "/" file)
+                     file
+                     (search-path %load-path file))))
+       (if (and file
+                (string-prefix? (%store-prefix) file))
+           (filter-map
+            (lambda (entry)
+              (let ((item (manifest-entry-item entry)))
+                (and (or (string-prefix? item file)
+                         (string=? "guix" (manifest-entry-name entry)))
+                     (manifest-entry-channel entry))))
+            (current-profile-entries))
+           '())))))
+
 (define* (derivation->job name drv
                           #:key
                           (max-silent-time 3600)