#lang scheme/base
(require "../base.ss"
(prefix-in plain: "../plain/render.ss")
"struct.ss")
(define (csv->string csv)
(define out (open-output-string))
(display-csv csv out)
(get-output-string out))
(define (display-csv csv out)
(cond [(sheet? csv) (display-sheet csv out)]
[(row? csv) (display-row csv out)]
[(cell? csv) (display-cell csv out)]))
(define (display-sheet sheet out)
(let loop ([rows (sheet-rows sheet)])
(cond [(null? rows) (void)]
[(null? (cdr rows)) (display-row (car rows) out)]
[else (display-row (car rows) out)
(newline out)
(loop (cdr rows))])))
(define (display-row row out)
(let loop ([cells (row-cells row)])
(cond [(null? cells) (void)]
[(null? (cdr cells)) (display-cell (car cells) out)]
[else (display-cell (car cells) out)
(display #\, out)
(loop (cdr cells))])))
(define (display-cell cell out)
(display (quotable-value->string (cell-value cell)) out))
(define (quotable-value->string val [pretty? #t])
(cond [(string? val) (add-quotes (escape-string val))]
[(symbol? val) (add-quotes (escape-string (symbol->string val)))]
[(bytes? val) (add-quotes (escape-string (bytes->string/utf-8 val)))]
[(number? val) (number->string val)]
[(boolean? val) (if val "yes" "")]
[(url? val) (add-quotes (escape-string (url->string val)))]
[(time-utc? val) (add-quotes (escape-string (plain:time-utc->string val)))]
[(time-tai? val) (add-quotes (escape-string (plain:time-tai->string val)))]))
(define NEWLINE-REGEXP #rx"[\r\n]+")
(define QUOTE-REGEXP #rx"\"")
(define (escape-string value)
(regexp-replace* QUOTE-REGEXP (regexp-replace* NEWLINE-REGEXP value " ") "\"\""))
(define (add-quotes val)
(string-append "\"" val "\""))
(provide/contract
[csv->string (-> csv? string?)])