records: Add `recutils->alist' for public consumption.
* guix/records.scm (%recutils-field-rx): New variable. (recutils->alist): New procedure, formerly known as `fields->alist'. * guix/scripts/substitute-binary.scm (fields->alist): Use it. * tests/records.scm ("recutils->alist"): New test.
This commit is contained in:
parent
c0edcc3c19
commit
fdc1bf659d
@ -21,9 +21,12 @@
|
|||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (ice-9 regex)
|
||||||
|
#:use-module (ice-9 rdelim)
|
||||||
#:export (define-record-type*
|
#:export (define-record-type*
|
||||||
alist->record
|
alist->record
|
||||||
object->fields))
|
object->fields
|
||||||
|
recutils->alist))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
@ -211,4 +214,24 @@ PORT, according to FIELDS. FIELDS must be a list of field name/getter pairs."
|
|||||||
(format port "~a: ~a~%" field (get object))
|
(format port "~a: ~a~%" field (get object))
|
||||||
(loop rest)))))
|
(loop rest)))))
|
||||||
|
|
||||||
|
(define %recutils-field-rx
|
||||||
|
(make-regexp "^([[:graph:]]+): (.*)$"))
|
||||||
|
|
||||||
|
(define (recutils->alist port)
|
||||||
|
"Read a recutils-style record from PORT and return it as a list of key/value
|
||||||
|
pairs. Stop upon an empty line (after consuming it) or EOF."
|
||||||
|
(let loop ((line (read-line port))
|
||||||
|
(result '()))
|
||||||
|
(cond ((or (eof-object? line) (string-null? line))
|
||||||
|
(reverse result))
|
||||||
|
((regexp-exec %recutils-field-rx line)
|
||||||
|
=>
|
||||||
|
(lambda (match)
|
||||||
|
(loop (read-line port)
|
||||||
|
(alist-cons (match:substring match 1)
|
||||||
|
(match:substring match 2)
|
||||||
|
result))))
|
||||||
|
(else
|
||||||
|
(error "unmatched line" line)))))
|
||||||
|
|
||||||
;;; records.scm ends here
|
;;; records.scm ends here
|
||||||
|
@ -102,23 +102,8 @@ output port, and PROC's result is returned."
|
|||||||
(define (fields->alist port)
|
(define (fields->alist port)
|
||||||
"Read recutils-style record from PORT and return them as a list of key/value
|
"Read recutils-style record from PORT and return them as a list of key/value
|
||||||
pairs."
|
pairs."
|
||||||
(define field-rx
|
(with-mutex %regexp-exec-mutex
|
||||||
(make-regexp "^([[:graph:]]+): (.*)$"))
|
(recutils->alist port)))
|
||||||
|
|
||||||
(let loop ((line (read-line port))
|
|
||||||
(result '()))
|
|
||||||
(cond ((eof-object? line)
|
|
||||||
(reverse result))
|
|
||||||
((with-mutex %regexp-exec-mutex
|
|
||||||
(regexp-exec field-rx line))
|
|
||||||
=>
|
|
||||||
(lambda (match)
|
|
||||||
(loop (read-line port)
|
|
||||||
(alist-cons (match:substring match 1)
|
|
||||||
(match:substring match 2)
|
|
||||||
result))))
|
|
||||||
(else
|
|
||||||
(error "unmatched line" line)))))
|
|
||||||
|
|
||||||
(define %fetch-timeout
|
(define %fetch-timeout
|
||||||
;; Number of seconds after which networking is considered "slow".
|
;; Number of seconds after which networking is considered "slow".
|
||||||
|
@ -131,6 +131,23 @@
|
|||||||
(parameterize ((mark (cons 'a 'b)))
|
(parameterize ((mark (cons 'a 'b)))
|
||||||
(eq? (foo-baz y) (mark))))))))
|
(eq? (foo-baz y) (mark))))))))
|
||||||
|
|
||||||
|
(test-equal "recutils->alist"
|
||||||
|
'((("Name" . "foo")
|
||||||
|
("Version" . "0.1")
|
||||||
|
("Synopsis" . "foo bar")
|
||||||
|
("Something_else" . "chbouib"))
|
||||||
|
(("Name" . "bar")
|
||||||
|
("Version" . "1.5")))
|
||||||
|
(let ((p (open-input-string "Name: foo
|
||||||
|
Version: 0.1
|
||||||
|
Synopsis: foo bar
|
||||||
|
Something_else: chbouib
|
||||||
|
|
||||||
|
Name: bar
|
||||||
|
Version: 1.5")))
|
||||||
|
(list (recutils->alist p)
|
||||||
|
(recutils->alist p))))
|
||||||
|
|
||||||
(test-end)
|
(test-end)
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user