#lang scheme
(require
 "packing.ss"
 "number.ss")

(define (with-size/p size packing #:adjustment [adjustment 0])
  (let ([size-packing (integer/p size #f)])
    (make-packing
     (λ (in)
       (let ([size ((packing-reader size-packing) in)])
         (if (not (eof-object? size))
             ((packing-reader packing) (make-limited-input-port in (+ size adjustment)))
             eof)))
     (λ (v out)
       (let ([b (call-with-output-bytes (curry (packing-writer packing) v))])
         ((packing-writer size-packing) (- (bytes-length b) adjustment) out)
         (write-bytes b out)))
     (packing-contract packing))))

(define (with-count/p size packing #:adjustment [adjustment 0])
  (let ([count-packing (integer/p size #f)])
    (make-packing
     (λ (in)
       (let ([count ((packing-reader count-packing) in)])
         (if (not (eof-object? count))
             (let ([count (+ count adjustment)])
               (let/ec esc
                 (do ([vs (make-vector count #f)] [i 0 (+ i 1)]) ((>= i count) vs)
                   (let ([v ((packing-reader packing) in)])
                     (if (not (eof-object? v))
                         (vector-set! vs i v)
                         (esc eof))))))
             eof)))
     (λ (v out)
       ((packing-writer count-packing) (- (vector-length v) adjustment) out)
       (for ([v (in-vector v)])
         ((packing-writer packing) v out)))
     (vectorof (packing-contract packing)))))

(define bytes/p
  (make-packing
   port->bytes
   write-bytes
   bytes?))

(define string/p
  (make-packing
   port->string
   write-string
   string?))

(define symbol/p
  (wrap/p
   string->symbol
   symbol->string
   string/p
   symbol?))

(provide/contract
 [with-size/p (->* ((or/c 1 2 4 8) packing?) (#:adjustment exact-integer?) packing?)]
 [with-count/p (->* ((or/c 1 2 4 8) packing?) (#:adjustment exact-integer?) packing?)])

(provide
 bytes/p string/p symbol/p)