#lang scheme/base
(require (planet bzlib/base)
         (for-syntax scheme/base "args.ss"))

(define-syntax (make-call-with-port stx)
  (syntax-case stx () 
    ((_ open-port close arg ...) 
     (with-syntax (((base-arg ...)
                    (args->non-kw-args #'(arg ...)))
                   ((base-id ...)
                    (args->non-kw-identifiers #'(arg ...)))
                   ((kw-arg ...)
                    (args->kw-args #'(arg ...)))
                   ((kw-id ...)
                    (args->kw-identifiers #'(arg ...))))
       #'(lambda (base-arg ... proc kw-arg ...)
           (let ((port (open-port base-id ... kw-id ...)))  
             (dynamic-wind void
                           (lambda ()
                             (proc port))
                           (lambda ()
                             (close port)))))))))

(define-syntax make-call-with-input-port
  (syntax-rules () 
    ((_ open args ...)
     (make-call-with-port open close-input-port args ...))))

(define-syntax make-call-with-output-port
  (syntax-rules () 
    ((_ open args ...)
     (make-call-with-port open close-output-port args ...))))

(define call-with-input-port 
  (make-call-with-input-port identity in))

(define call-with-output-port
  (make-call-with-output-port identity out))

;; below are used for creating custom ports...
;; these are the basic signature for making custom port...
(define (make-default-read in)
  (lambda (bytes)
    (let* ((len (bytes-length bytes))
           (bytes-in (read-bytes len in)))
      (cond ((eof-object? bytes-in)
             eof)
            (else
             (bytes-copy! bytes 0 bytes-in)
             (bytes-length bytes-in))))))

(define (make-default-peek in)
  (lambda (bytes skip progress-evt)
    (let* ((len (bytes-length bytes))
           (peeked (peek-bytes len
                               skip in)))
      (cond ((eof-object? peeked) eof)
            (else (bytes-copy! bytes 0
                               peeked)
                  ;;len ;; it's clear this is not the perf bottleneck
                  (bytes-length peeked)
                  )))))

(define-struct abytes (bytes port) #:property prop:input-port 1)

(define (open-input-abytes bytes)
  (make-abytes bytes (open-input-bytes bytes)))

(define (reopen-input-port in)
  (cond ((file-stream-port? in)
         (let ((path (object-name in)))
           (open-input-file in)))
        ((abytes? in)
         (open-input-abytes (abytes-bytes in)))))

(define (reopenable-input-port? in)
  (and (input-port? in)
       (or (abytes? in) (file-stream-port? in))))

;; syntax export
(provide make-call-with-input-port make-call-with-output-port)

(provide/contract 
 (call-with-input-port (-> input-port? (-> input-port? any) any))
 (call-with-output-port (-> output-port? (-> output-port? any) any))
 (make-default-read (-> input-port? (-> bytes? any)))
 (make-default-peek (-> input-port? (-> bytes? any/c any/c any)))
 (reopen-input-port (-> reopenable-input-port? input-port?)) 
 (reopenable-input-port? (-> any/c boolean?))
 (open-input-abytes (-> bytes? abytes?))
 (abytes? (-> any/c boolean?))
 )