From mboxrd@z Thu Jan 1 00:00:00 1970 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Subject: [PATCH 5/6] services: Add 'lookup-service-types'. Date: Wed, 8 Nov 2017 14:09:20 +0100 Message-ID: <20171108130921.25202-6-ludo@gnu.org> References: <87zi7xwvso.fsf_-_@gnu.org> <20171108130921.25202-1-ludo@gnu.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:55091) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eCQ6y-0006YP-A9 for guix-devel@gnu.org; Wed, 08 Nov 2017 08:09:45 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eCQ6x-0004S1-FC for guix-devel@gnu.org; Wed, 08 Nov 2017 08:09:44 -0500 In-Reply-To: <20171108130921.25202-1-ludo@gnu.org> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org * gnu/services.scm (lookup-service-types): New procedure. * tests/services.scm ("lookup-service-types"): New test. --- gnu/services.scm | 11 +++++++++++ tests/services.scm | 10 +++++++++- 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/gnu/services.scm b/gnu/services.scm index df1bedeb9..016ff08e0 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -55,6 +55,7 @@ %service-type-path fold-service-types + lookup-service-types service service? @@ -192,6 +193,16 @@ is used as the initial value of RESULT." seed modules)) +(define lookup-service-types + (let ((table + (delay (fold-service-types (lambda (type result) + (vhash-consq (service-type-name type) + type result)) + vlist-null)))) + (lambda (name) + "Return the list of services with the given NAME (a symbol)." + (vhash-foldq* cons '() name (force table))))) + ;; Services of a given type. (define-record-type (make-service type value) diff --git a/tests/services.scm b/tests/services.scm index 8484ee982..ca32b565c 100644 --- a/tests/services.scm +++ b/tests/services.scm @@ -23,7 +23,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) - #:use-module (srfi srfi-64)) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) (define live-service (@@ (gnu services herd) live-service)) @@ -206,4 +207,11 @@ (list (map live-service-provision unload) (map shepherd-service-provision load))))) +(test-eq "lookup-service-types" + system-service-type + (and (null? (lookup-service-types 'does-not-exist-at-all)) + (match (lookup-service-types 'system) + ((one) one) + (x x)))) + (test-end) -- 2.15.0