#lang scheme

(define string-strip
  (let ([left #px"^\\s+"] [right #px"\\s+$"])
    (λ (s)
      (regexp-replace right (regexp-replace left s "") ""))))

(define column-split
  (let ([pattern #px"\\s*\\|\\s*"])
    (λ (s)
      (regexp-split pattern s))))

(define (generate)
  (let-values ([(process input output error) 
                (subprocess #f #f (open-output-file "error.log" #:exists 'replace) "/usr/bin/psql" "-U" "www" "-p" "5433" "test")])
    (display "\\t\n" output)
    (flush-output output)
    (read-line input)
    (values
     (make-input-port 
      'psql
      (λ (s)
        (sync/enable-break input)
        (let loop ([line (string-strip (read-line input))])
          (if (= (string-length line) 0) 
              (begin
                (sync/enable-break input)
                (loop (string-strip (read-line input))))
              (λ args 
                (column-split line)))))
      (λ args "")
      (λ ()
        (close-input-port input)))
     (make-output-port
      'psql
      output
      (λ (bytes start end keep? break?)
        (display (subbytes bytes start end) output)
        (display "\n" output)
        (flush-output output) ; forget about keep, eh
        (if break? (sync/enable-break output) (sync output))
        (- end start))
      (λ ()
        (close-output-port output)
        (subprocess-kill process #f)
        (subprocess-wait process))))))

(provide generate)