#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PORT.plt - port utilities 
;;
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; util.ss - a bunch of port utilities.
(require "depend.ss" "port.ss" "filter.ss"
         )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; abytes - abstraction over bytes...
(define-struct abytes (port bytes)
  #:property prop:input-port 0)

(define (open-input-abytes b)
  (define (helper b)
    (if (string? b)
        (string->bytes/utf-8 b)
        b))
  (define (make b)
    (make-abytes (open-input-bytes b) b))
  (make (helper b)))

(define (call-with-output-abytes proc)
  (open-input-abytes (call-with-output-bytes proc)))

(define (port->abytes in)
  (open-input-abytes (port->bytes in))) 

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; reopen-input-ports
(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))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; append port
;; this is a structure atop of the regular port append...
(define-struct append-port (inner ports) 
  #:property prop:input-port 0)

(define (open-append-port close? in . ins)
  (define (port-helper p)
    (if (input-port? p)
        p
        (open-input-abytes p)))
  (define (helper ins)
    (make-append-port (apply input-port-append close? ins) ins))
  (helper (map port-helper (cons in ins))))

(define input/c (or/c bytes? string? input-port?))

(define input-port-length-registry (make-cond-registry))

(define (input-port-length-registry-set! type? length?)
  (registry-set! input-port-length-registry type? length?))

(define (input-port-length-registry-del! type?)
  (registry-del! input-port-length-registry type?))

;; input-port-length
(define (input-port-length in)
  ((registry-ref input-port-length-registry in
                 (lambda (in)
                   (error 'input-port-length "unsupported: ~a" in))) in))

(input-port-length-registry-set! file-stream-port? file-size)
(input-port-length-registry-set! abytes? (lambda (in)
                                           (bytes-length (abytes-bytes in))))
(input-port-length-registry-set! append-port?
                                 (lambda (in)
                                   (apply + (map input-port-length 
                                                 (append-port-ports in)))))


;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; line-term-filter
(define (line-term/sys (sys (system-type 'os)))
  (case sys
    ((windows) 'return-linefeed)
    (else 'linefeed)))

(define (line-term/network) 'return-linefeed) 
  
(define line-term (make-parameter 'any))

(define (line-term? v)
  (case v 
    ((return linefeed return-linefeed any any-one) #t)
    ((windows macosx unix network) #t)
    (else #f)))

;; what do you do when it's any or any-one?
;; this should return it by the type of the os...
;; hmm...
(define (line-term/string (line-term (line-term)))
  (bytes->string/latin-1 (line-term/bytes line-term)))

(define (line-term/bytes (line-term (line-term)))
  (case line-term
    ((any any-one) (line-term/bytes (line-term/sys)))
    ((return) #"\r")
    ((linefeed) #"\n")
    ((return-linefeed) #"\r\n")
    ((windows unix macosx) (line-term/bytes (line-term/sys line-term)))
    ((network) (line-term/bytes (line-term/network)))))

(define (line-term-filter in out) 
  (define (helper v) 
    (unless (eof-object? v)
      (write-bytes v out)
      (write-bytes (line-term/bytes) out)
      (helper (read-bytes-line in 'any))))
  (helper (read-bytes-line in 'any)))

(define (byte-counter in)
  (let loop ((v (read-bytes 2048 in))
             (count 0))
    (if (eof-object? v)
        count
        (loop (read-bytes 2048 in) (+ (bytes-length v) count)))))


;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; line-term-filter
(provide/contract 
 (reopen-input-port (-> reopenable-input-port? input-port?)) 
 (reopenable-input-port? (-> any/c boolean?))
 (open-input-abytes (-> (or/c bytes? string?) abytes?))
 (abytes? (-> any/c boolean?))
 (abytes-bytes (-> abytes? bytes?))
 (call-with-output-abytes (->  (-> any) any))
 (port->abytes (-> input-port? any))
 (input-port-length (-> input-port? number?))
 (input-port-length-registry-set! (-> (-> any/c any) (-> input-port? integer?) any))
 (input-port-length-registry-del! (-> (-> any/c any)  any))
 (append-port? (-> any/c boolean?))
 (open-append-port (->* (boolean? input/c)
                        ()
                        #:rest (listof input/c)
                        append-port?))
 (append-port-ports (-> append-port? (listof input-port?)))
 (line-term (parameter/c line-term?))
 (line-term/sys (->* () 
                     ((or/c 'linux 'windows 'macosx)) 
                     line-term?))
 (line-term/network (-> line-term?))
 (line-term? (-> any/c boolean?))
 (line-term/string (->* () (line-term?) string?))
 (line-term/bytes (->* () (line-term?) bytes?))
 (line-term-filter (-> input-port? output-port? any))
 )