From c8772a7a21f954b5e75746529e70edc3a1017249 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 10 Jul 2013 18:04:08 +0200 Subject: [PATCH] records: `alist->record' supports multiple-field occurrences. * guix/records.scm (alist->record): Add `multiple-value-keys' parameter. Update docstring, and honor it. * tests/records.scm ("alist->record"): New record. --- guix/records.scm | 16 +++++++++++++--- tests/records.scm | 6 ++++++ 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/guix/records.scm b/guix/records.scm index 57664df5a6..8dc733b8ff 100644 --- a/guix/records.scm +++ b/guix/records.scm @@ -198,9 +198,19 @@ (define-record-type type #'((field options ...) ...)))))))))) -(define (alist->record alist make keys) - "Apply MAKE to the values associated with KEYS in ALIST." - (let ((args (map (cut assoc-ref alist <>) keys))) +(define* (alist->record alist make keys + #:optional (multiple-value-keys '())) + "Apply MAKE to the values associated with KEYS in ALIST. Items in KEYS that +are also in MULTIPLE-VALUE-KEYS are considered to occur possibly multiple +times in ALIST, and thus their value is a list." + (let ((args (map (lambda (key) + (if (member key multiple-value-keys) + (filter-map (match-lambda + ((k . v) + (and (equal? k key) v))) + alist) + (assoc-ref alist key))) + keys))) (apply make args))) (define (object->fields object fields port) diff --git a/tests/records.scm b/tests/records.scm index d0635ebb1f..712eb83a09 100644 --- a/tests/records.scm +++ b/tests/records.scm @@ -158,6 +158,12 @@ (define-record-type* foo make-foo (list (recutils->alist p) (recutils->alist p)))) +(test-equal "alist->record" '((1 2) b c) + (alist->record '(("a" . 1) ("b" . b) ("c" . c) ("a" . 2)) + list + '("a" "b" "c") + '("a"))) + (test-end)