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:
Ludovic Courtès 2013-07-10 16:54:17 +02:00
parent c0edcc3c19
commit fdc1bf659d
3 changed files with 43 additions and 18 deletions

View file

@ -21,9 +21,12 @@ (define-module (guix records)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 rdelim)
#:export (define-record-type*
alist->record
object->fields))
object->fields
recutils->alist))
;;; Commentary:
;;;
@ -211,4 +214,24 @@ (define (object->fields object fields port)
(format port "~a: ~a~%" field (get object))
(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

View file

@ -102,23 +102,8 @@ (define string->uri
(define (fields->alist port)
"Read recutils-style record from PORT and return them as a list of key/value
pairs."
(define field-rx
(make-regexp "^([[:graph:]]+): (.*)$"))
(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)))))
(with-mutex %regexp-exec-mutex
(recutils->alist port)))
(define %fetch-timeout
;; Number of seconds after which networking is considered "slow".

View file

@ -131,6 +131,23 @@ (define-record-type* <foo> foo make-foo
(parameterize ((mark (cons 'a 'b)))
(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)