From badf788f157a8bffe9fc0695763dc811439dc81b Mon Sep 17 00:00:00 2001 From: Andrew Tropin Date: Tue, 28 Sep 2021 12:30:55 +0300 Subject: home-services: Add missing imports and function definition. * gnu/home-services/configuration.scm: Add missing imports. * gnu/home-services/utils.scm (list->human-readable-list): Add new function. * gnu/home-services/configuration.scm: Add missing imports. * gnu/home-services/xdg.scm: Fix ensure-list function. * guix/scripts/home/import.scm: Add missing imports. Signed-off-by: Oleg Pykhalov --- gnu/home-services/configuration.scm | 2 ++ gnu/home-services/utils.scm | 30 +++++++++++++++++++++++++++++- gnu/home-services/xdg.scm | 12 +++++++----- guix/scripts/home/import.scm | 4 ++++ 4 files changed, 42 insertions(+), 6 deletions(-) diff --git a/gnu/home-services/configuration.scm b/gnu/home-services/configuration.scm index 3698006c37..e8f4bc77ec 100644 --- a/gnu/home-services/configuration.scm +++ b/gnu/home-services/configuration.scm @@ -23,6 +23,8 @@ #:use-module (srfi srfi-1) #:use-module (ice-9 curried-definitions) #:use-module (ice-9 match) + #:use-module (guix i18n) + #:use-module (guix diagnostics) #:export (filter-configuration-fields diff --git a/gnu/home-services/utils.scm b/gnu/home-services/utils.scm index 3e490a0515..f13133a7ae 100644 --- a/gnu/home-services/utils.scm +++ b/gnu/home-services/utils.scm @@ -24,7 +24,8 @@ #:export (maybe-object->string object->snake-case-string - object->camel-case-string)) + object->camel-case-string + list->human-readable-list)) (define (maybe-object->string object) "Like @code{object->string} but don't do anyting if OBJECT already is @@ -75,3 +76,30 @@ STYLE can be three `@code{lower}', `@code{upper}', defaults to (cons (first splitted-string) (map string-capitalize (cdr splitted-string)))))))))) + +(define* (list->human-readable-list lst + #:key + (cumulative? #f) + (proc identity)) + "Turn a list LST into a sequence of terms readable by humans. +If CUMULATIVE? is @code{#t}, use ``and'', otherwise use ``or'' before +the last term. + +PROC is a procedure to apply to each of the elements of a list before +turning them into a single human readable string. + +@example +(list->human-readable-list '(1 4 9) #:cumulative? #t #:proc sqrt) +@result{} \"1, 2, and 3\" +@end example + +yields:" + (let* ((word (if cumulative? "and " "or ")) + (init (append (drop-right lst 1)))) + (format #f "~a" (string-append + (string-join + (map (compose maybe-object->string proc) init) + ", " 'suffix) + word + (maybe-object->string (proc (last lst))))))) + diff --git a/gnu/home-services/xdg.scm b/gnu/home-services/xdg.scm index 457ce999a1..94275f3b65 100644 --- a/gnu/home-services/xdg.scm +++ b/gnu/home-services/xdg.scm @@ -287,9 +287,9 @@ The value of an XDG MIME entry must be a list, string or symbol, was given ~a") @example (merge-duplicates '((key1 . value1) - (key2 . value2) - (key1 . value3) - (key1 . value4)) '()) + (key2 . value2) + (key1 . value3) + (key1 . value4)) '()) @result{} ((key1 . (value4 value3 value1)) (key2 . value2)) @end example" @@ -299,14 +299,16 @@ The value of an XDG MIME entry must be a list, string or symbol, was given ~a") (tail (cdr alist)) (key (first head)) (value (cdr head)) - (duplicate? (assoc key acc))) + (duplicate? (assoc key acc)) + (ensure-list (lambda (x) + (if (list? x) x (list x))))) (if duplicate? ;; XXX: This will change the order of things, ;; though, it shouldn't be a problem for XDG MIME. (merge-duplicates tail (alist-cons key - (cons value (maybe-list (cdr duplicate?))) + (cons value (ensure-list (cdr duplicate?))) (alist-delete key acc))) (merge-duplicates tail (cons head acc))))))) diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm index 39f45dbeac..79fb23a2fd 100644 --- a/guix/scripts/home/import.scm +++ b/guix/scripts/home/import.scm @@ -20,9 +20,13 @@ (define-module (guix scripts home import) #:use-module (guix profiles) #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (gnu packages) #:use-module (ice-9 match) #:use-module (ice-9 pretty-print) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:export (import-manifest)) ;;; Commentary: -- cgit v1.2.3