port-split.scm

; port-split
(define-module csv.port-split
  (use gauche.generator)
  (use gauche.vport)
  (export
    port-split-record
    port-split-field) )
(select-module csv.port-split)

(define (port-drop-while pred port)
  (let loop []
    (let1 e (peek-char port)
      (cond [(eof-object? e) #t]
            [(pred e) (read-char port) (loop) ]
            [else #t] ) ) ) )

(define null-port (make <virtual-input-port> :getc null-generator) )

; port-split-record : record splitter
; terminator? ... record terminator?
(define (port-split-record terminator? port)
  (define (main)
    (let1 e (peek-char port)
      (cond
        [(eof-object? e) (set! main null-generator) (eof-object) ]
        [(terminator? e) (read-char port) null-port ] ; null record
        [else
          (letrec [[rg (^[] ; record generator
                          (let1 e (read-char port)
                            (cond [(eof-object? e)
                                      (set! main null-generator)
                                      (set! rg   null-generator)
                                      (eof-object) ]
                                  [(terminator? e)
                                      (set! rg null-generator)
                                      (eof-object) ]
                                  [else e ] ) ) ) ]]
            (make <virtual-input-port> :getc (^[] (rg) ) ) ) ]
      ) ) )
  (^[] (main)) )

; port-split-field : csv like field splitter
; separator? ... is element separator?
; quote?     ... is element quote?
; skip?      ... skip element?
; quoted-gen ... quoted generator
(define (port-split-field separator? quote? skip? port)
  (define (main)
    (port-drop-while skip? port)
    (let1 e (peek-char port)
      ;#?=e
      (cond
        [(eof-object? e) (set! main null-generator) null-port ]
        [(separator? e)  (read-char port) null-port ] ; null record
        [(quote? e) ; quoted generator
          (read-char port)
          (letrec [[qg (^[]
                          (let1 e (read-char port)
                            (cond [(eof-object? e) (error "unterminated quoted field")]
                                  [(quote? e)
                                    (let1 e (peek-char port)
                                      (if (quote? e)
                                        (read-char port)
                                        (begin ; end of quoted generator
                                          (port-drop-while (complement separator?) port)
                                          (read-char port) ; drop separator
                                          (set! qg null-generator)
                                          (eof-object) ) ) ) ]
                                  [else e ] ) ) ) ] ]
            (make <virtual-input-port> :getc (^[] (qg) ) ) ) ]
        [else
          (letrec [[uqg (^[]
                          (let1 e (read-char port)
                            (cond [(eof-object? e)
                                      (set! main null-generator)
                                      (set! uqg   null-generator)
                                      (eof-object) ]
                                  [(separator? e)
                                      (set! uqg null-generator)
                                      (eof-object) ]
                                  [else e ] ) ) ) ]]
            (make <virtual-input-port> :getc (^[] (uqg) ) ) ) ] ) ; unquote generator
      ) )
  (^[] (main) ) )

test.scm

#!/usr/bin/env gosh
;;; -*- mode: scheme; coding: utf-8 -*-

;;(use csv.csv :prefix test:)
(use text.csv)
(use gauche.vport)

(use csv.gsplit)
(use csv.port-split)
(use gauche.generator)

(define (gsplit-read-csv sep quo port)
  ($ generator->list
  $ gmap ($ generator->list
          $ gmap ($ list->string $ generator->list $)
          $ gsplit-field ($ eqv? sep $) ($ eqv? quo $) char-whitespace? $)
  $ gsplit-record ($ eqv? #\newline $) $ port->char-generator port) )

(define (port-split-read-csv sep quo port)
  ($ generator->list
  $ gmap ($ generator->list
          $ gmap (^p (call-with-output-string (cut copy-port p <> :unit 'char ) ) )
          $ port-split-field ($ eqv? sep $) ($ eqv? quo $) char-whitespace? $)
  $ port-split-record ($ eqv? #\newline $) port) )

(define sep #\,)
(define quo #\')
(define reader (make-csv-reader sep quo))

;#?=(call-with-output-string ($ copy-port (open-input-string ",愛") $) )
;(exit)

;(define line ",愛,,")
;#?=(port-split-read-csv sep quo (open-input-string line) )
;#?=(port->list reader (open-input-string line) )
;(exit)

;----------------------------------------------

(define (null-port)
  (make <virtual-input-port> :getc null-generator) )

(define (greader sep quo port)
  (let1 line (read-line port)
    (if (eof-object? line)
      (eof-object)
      ($ generator->list
        $ gmap ($ list->string $ generator->list $)
        $ gsplit-field ($ eqv? sep $) ($ eqv? quo $) char-whitespace?
        $ string->generator line) ) ) )

(define (preader sep quo port)
  (let1 line (read-line port)
    (if (eof-object? line)
      (eof-object)
      ($ generator->list
        $ gmap (^p (call-with-output-string (cut copy-port p <> :unit 'char ) ) )
        $ port-split-field ($ eqv? sep $) ($ eqv? quo $) char-whitespace?
        $ open-input-string line) ) ) )

(define test:reader ($ preader sep quo $) )

(define (main args)
  (define (read-data reader fname)
    (call-with-input-file fname
      (^ [in] (port->list reader in) )
      :encoding "Shift_JIS") )
;   ($ time $ with-output-to-file "csv-org.txt"
;     (^[] ($ for-each write $ read-data reader (cadr args) ) ) )
   ($ time $ with-output-to-file "csv-test.txt"
     (^[] ($ for-each write $ read-data test:reader (cadr args) ) ) )
  0)