#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PORT.plt - port utilities 
;;
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; port.ss - utilities for creating port utilites.
;; yc 9/21/2009 - first version
;; yc 1/21/2010 - expose abytes-bytes & abytes-length
;; yc 1/21/2010 - modify abytes to take string as well so it will convert string into bytes/utf-8
;; yc 1/21/2010 - move abytes & reopen to util.ss
;; yc 2/13/2010 - add default custom output-port utility functions.
(require "depend.ss"
         (for-syntax scheme/base "depend.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 (make-default-write out)
  (lambda (bytes-out start end block? break?)
    (cond ((= start end)
           (flush-output out)
           0)
          (else
           (write-bytes bytes-out out start end)))))

(define (make-default-close-output-port out (proc void))
  (lambda ()
    (dynamic-wind void 
                  void
                  (lambda () 
                    (close-output-port out)
                    (proc)))))

(define (make-default-close-input-port in (proc void))
  (lambda () 
    (dynamic-wind void 
                  void
                  (lambda () 
                    (close-input-port in)
                    (proc)))))

;; 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)))
 (make-default-write (-> output-port? (-> bytes? integer? integer? boolean? boolean? any)))
 (make-default-close-output-port (-> output-port? thunk? thunk?))
 (make-default-close-input-port (-> input-port? thunk? thunk?))
 )