functions: Add read-org-tbfs.

This commit is contained in:
Sergiu Ivanov 2020-07-09 01:03:24 +02:00
parent c999b4c6ce
commit 7d825d0a83

View file

@ -35,7 +35,8 @@
[apply-tbf (-> tbf? (vectorof (or/c 0 1)) (or/c 0 1))] [apply-tbf (-> tbf? (vectorof (or/c 0 1)) (or/c 0 1))]
[apply-tbf/boolean (-> tbf? (vectorof boolean?) boolean?)] [apply-tbf/boolean (-> tbf? (vectorof boolean?) boolean?)]
[list->tbf (-> (cons/c number? (cons/c number? (listof number?))) tbf?)] [list->tbf (-> (cons/c number? (cons/c number? (listof number?))) tbf?)]
[read-tbfs (-> (listof (listof number?)) (listof tbf?))])) [read-tbfs (-> (listof (listof number?)) (listof tbf?))]
[read-org-tbfs (->* (string?) (#:headers boolean?) (listof tbf?))]))
(module+ test (module+ test
(require rackunit)) (require rackunit))
@ -300,3 +301,19 @@
(test-case "read-tbfs" (test-case "read-tbfs"
(check-equal? (read-tbfs '((1 2 3) (2 3 4))) (check-equal? (read-tbfs '((1 2 3) (2 3 4)))
(list (tbf '#(1 2) 3) (tbf '#(2 3) 4))))) (list (tbf '#(1 2) 3) (tbf '#(2 3) 4)))))
;;; Reads a list of TBF from an Org-mode string containing a sexp,
;;; containing a list of lists of numbers. If headers is #t, drops
;;; the first list, supposing that it contains the headers of the
;;; table.
;;;
;;; The input is typically what read-org-sexp reads.
(define (read-org-tbfs str #:headers [headers #f])
(define sexp (read-org-sexp str))
(define sexp-clean (cond [headers (cdr sexp)] [else sexp]))
(read-tbfs sexp-clean))
(module+ test
(test-case "read-org-tbfs"
(check-equal? (read-org-tbfs "((1 2 1) (1 0 1))")
(list (tbf '#(1 2) 1) (tbf '#(1 0) 1)))))