#lang scheme/base

(require (prefix-in log: (planet synx/log:1))
         (only-in "system.ss" good-port)
         scheme/port
         scheme/gui/base)

(define (gui-copy src dst)
  (with-input-from-file src
    (λ ()
      (with-output-to-file dst
        (λ ()
          (let ((buffer (make-bytes 4096)))
            (let loop ()
              (yield (current-input-port))
              (let ((amount (read-bytes! buffer)))
                (if (eof-object? amount) (void)
                    (begin
                      (write-bytes buffer (current-output-port) 0 amount)
                      (loop)))))))))))

(define (new-system command . args)
  (log:info "systemboo ~s ~s" command args)
  (let-values (((pid foo bar blech) (apply subprocess
                                           (good-port (current-output-port))
                                           (good-port (current-input-port))
                                           (good-port (current-error-port))
                                           command
                                           args)))
    (yield pid)
    (= 0 (subprocess-status pid))))


(define (schlorp command . args)
  (let-values (((pid input bar blech) (apply subprocess
                                           #f
                                           (good-port (current-input-port))
                                           (good-port (current-error-port))
                                           command
                                           args)))
    (begin0
      (port->bytes input)
      (yield pid))))

(provide
 (rename-out (new-system system*)
             (gui-copy copy-file))
 schlorp
 good-port)