summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-04-30 12:57:23 +0200
committerLudovic Courtès <ludo@gnu.org>2018-04-30 14:22:43 +0200
commit6ac8b7359a1ac80e558f41dd37004ffa727dd3c6 (patch)
treee83df90254f1bd8f6d994f9900078b2fe4365e81
parentf675d8b97d2f2acd5277088940601cf5f2eb43db (diff)
downloadguix-6ac8b7359a1ac80e558f41dd37004ffa727dd3c6.tar.gz
guix system: search: Display default Shepherd service names.
Fixes <https://bugs.gnu.org/29707>.
Reported by Clément Lassieur <clement@lassieur.org>.

* guix/scripts/system/search.scm (service-type-default-shepherd-services)
(service-type-shepherd-names): New procedures.
(service-type->recutils): Use it.
* tests/guix-system.sh: Add test.
-rw-r--r--guix/scripts/system/search.scm37
-rw-r--r--tests/guix-system.sh3
2 files changed, 38 insertions, 2 deletions
diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm
index b4f790c9bf..7229c60a02 100644
--- a/guix/scripts/system/search.scm
+++ b/guix/scripts/system/search.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,9 +20,11 @@
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (gnu services)
+  #:use-module (gnu services shepherd)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
   #:export (service-type->recutils
@@ -39,6 +41,29 @@
 (define service-type-name*
   (compose symbol->string service-type-name))
 
+(define (service-type-default-shepherd-services type)
+  "Return the list of Shepherd services created by default instances of TYPE,
+provided TYPE has a default value."
+  (match (guard (c ((service-error? c) #f))
+           (service type))
+    (#f '())
+    ((? service? service)
+     (let* ((extension (find (lambda (extension)
+                               (eq? (service-extension-target extension)
+                                    shepherd-root-service-type))
+                             (service-type-extensions type)))
+            (compute   (and extension (service-extension-compute extension))))
+       (if compute
+           (compute (service-value service))
+           '())))))
+
+(define (service-type-shepherd-names type)
+  "Return the default names of Shepherd services created for TYPE."
+  (match (map shepherd-service-provision
+              (service-type-default-shepherd-services type))
+    (((names . _) ...)
+     names)))
+
 (define* (service-type->recutils type port
                                  #:optional (width (%text-width))
                                  #:key (extra-fields '()))
@@ -66,6 +91,16 @@ columns."
   (format port "extends: ~a~%"
           (extensions->recutils (service-type-extensions type)))
 
+  ;; If possible, display the list of *default* Shepherd service names.  Note
+  ;; that we may not always be able to do this (e.g., if the service type
+  ;; lacks a default value); furthermore, it could be that the service
+  ;; generates Shepherd services with different names if we give it different
+  ;; parameters (this is the case, for instance, for
+  ;; 'console-font-service-type'.)
+  (match (service-type-shepherd-names type)
+    (()    #f)
+    (names (format port "shepherdnames:~{ ~a~}~%" names)))
+
   (when (service-type-description type)
     (format port "~a~%"
             (string->recutils
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 211c26f43d..ff9114ab74 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 # Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 #
@@ -267,6 +267,7 @@ guix system build "$tmpdir/config.scm" -n
 
 # Searching.
 guix system search tor | grep "^name: tor"
+guix system search tor | grep "^shepherdnames: tor"
 guix system search anonym network | grep "^name: tor"
 
 # Below, use -n (--dry-run) for the tests because if we actually tried to