~ruther/guix-local

fdc1bf659d9834fce6c78d31680b580eab3f4235 — Ludovic Courtès 12 years ago c0edcc3
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.
3 files changed, 43 insertions(+), 18 deletions(-)

M guix/records.scm
M guix/scripts/substitute-binary.scm
M tests/records.scm
M guix/records.scm => guix/records.scm +24 -1
@@ 21,9 21,12 @@
  #: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 @@ PORT, according to FIELDS.  FIELDS must be a list of field name/getter pairs."
       (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

M guix/scripts/substitute-binary.scm => guix/scripts/substitute-binary.scm +2 -17
@@ 102,23 102,8 @@ output port, and PROC's result is returned."
(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".

M tests/records.scm => tests/records.scm +17 -0
@@ 131,6 131,23 @@
             (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)