;;;; csv-xml-test.scm  -*- Hen -*-

(use csv-xml)

;;;

;Need to process `#lang' as well. So just "commented out" the "offending"
;sections in the source.
#;(define-syntax require (syntax-rules () ((_ ?x0 ...) (begin))))

(use testeez)
(include "test-csv.ss")

;;;

(newline)

(use test)

;;

(test-begin "csv-xml in")

(define +reader-spec-default+ '(
  (newline-type . lax)
  (separator-chars #\,)
  (quote-char . #\")
  (quote-doubling-escapes? . #t)
  (comment-chars)
  (whitespace-chars #\space)
  (strip-leading-whitespace? . #f)
  (strip-trailing-whitespace? . #f)
  (newlines-in-quotes? . #t)
))

(test "reader-spec defaults"
  +reader-spec-default+ (reader-spec))

(define +reader-spec-default-2+ '(
  (newline-type . lax)
  (separator-chars #\,)
  (quote-char . #\")
  (quote-doubling-escapes? . #f)
  (comment-chars)
  (whitespace-chars #\space)
  (strip-leading-whitespace? . #f)
  (strip-trailing-whitespace? . #f)
  (newlines-in-quotes? . #t)
))

(test "reader-spec overrides"
  +reader-spec-default-2+ (reader-spec #:quote-doubling-escapes? #f))

(test-end "csv-xml in")

;;

(test-begin "csv-xml out")

;

(define +writer-spec-default+ '(
  (newline-char . #t)
  (separator-char . #\,)
  (quote-char . #\")
  (comment-char . #\#)
  (quote-doubling-escapes? . #t)
  (quote-controls? . #t)
  (always-quote? . #t)
))

(define +writer-spec-default-2+ '(
  (newline-char . #f)
  (separator-char . #\,)
  (quote-char . #\")
  (comment-char . #\#)
  (quote-doubling-escapes? . #t)
  (quote-controls? . #t)
  (always-quote? . #t)
))

;

(test "writer-spec defaults" +writer-spec-default+ (writer-spec))

(test "writer-spec overrides" +writer-spec-default-2+ (writer-spec #:newline-char #f))

;

(define +list-in-1+ '((1 22 333) (11 2222 333333)))

(define +list-in-2+ '((1 22 333) "a comment" (11 2222 333333)))

#|
(define +list->sxml-out-1+ '(
  *TOP*
  (scull
    (foo "1")
    (bar "22")
    (baz "333"))
  (scull
    (foo "11")
    (bar "2222")
    (baz "333333"))
))

(define +list->sxml-out-2+ '(
  *TOP*
  (scull
    (foo "1")
    (bar "22")
    (baz "333"))
  (*COMMENT* "a comment")
  (scull
    (foo "11")
    (bar "2222")
    (baz "333333"))
))

;

(test "sxml"
  +list->sxml-out-1+ (list->sxml +list-in-1+ 'scull '(foo bar baz)))

(test "sxml & comment w/ comments"
  +list->sxml-out-2+ (list->sxml +list-in-2+ 'scull '(foo bar baz)))
|#

;

(use ports)

(test "csv"
  "\"1\",\"22\",\"333\"\n\"11\",\"2222\",\"333333\"\n"
  (with-output-to-string
    (lambda ()
      (list->csv +list-in-1+))))

(test "csv & comment w/ comments"
  "\"1\",\"22\",\"333\"\n#a comment\n\"11\",\"2222\",\"333333\"\n"
  (with-output-to-string
    (lambda ()
      (let ((writer
              (make-csv-writer
                (current-output-port)
                (writer-spec #:comment-char #\#))))
        ;(test-assert (procedure? writer))
        (list->csv +list-in-2+ writer)))))

(test "csv & comment w/o comments"
  "\"1\",\"22\",\"333\"\na comment\"11\",\"2222\",\"333333\"\n"
  (with-output-to-string
    (lambda ()
      (let ((writer
              (make-csv-writer
                (current-output-port)
                (writer-spec #:comment-char #f))))
        ;(test-assert (procedure? writer))
        (list->csv +list-in-2+ writer)))))

(test-end "csv-xml out")

;;

(use extras)

(define (read-csv string delimiter)
  (csv->list (make-csv-reader string `((separator-chars ,delimiter)))))

(define (write-csv rows delimiter)
  (call-with-output-string
   (lambda (out)
     (let ((writer (writer-spec separator-char: delimiter always-quote?: #f)))
       (list->csv rows (make-csv-writer out writer))))))

(define rows '(("f\"o\"o" "1") ("b,a,r" "2") ("b'a'z" "3")))

(let* ((delimiter #\,)
       (csv (write-csv rows delimiter)))
  (printf "Serialized form (always-quote?: #f):\n~a\n" csv)
  (let ((result (read-csv csv delimiter)))
    (test "Roundtrip" rows result) ) )

;;

(test-exit)