#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; BASE.plt - common routines that are shared by all other bzlib modules
;;
;; in a way, base.plt is the most fundamental module of the whole bzlib stack
;; and as such it also is the lowest level code.  We are not likely to
;; fix the code any time soon, and hence any of the functions here are
;; explicitly likely to be obsoleted or moved elsewhere.
;;
;; Proceed with caution.
;;
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; bytes.ss - provides utility functions that works with bytes
;; yc 10/19/2009 - first version

(require scheme/port mzlib/trace scheme/contract)


(define (port->bytes/charset in charset-in charset-out)
  (call-with-output-bytes 
   (lambda (out)
     (convert-stream charset-in in charset-out out))))

(define (bytes->bytes/charset bytes charset-in charset-out)
  (port->bytes/charset (open-input-bytes bytes) charset-in charset-out))

(define (bytes/charset->bytes/utf-8 bytes charset)
  (bytes->bytes/charset bytes charset "utf-8")) 

(define (bytes/utf-8->bytes/charset bytes charset)
  (bytes->bytes/charset bytes "utf-8" charset))

;; there are more to handle (specifically charsets).
(define (bytes/charset->string bytes charset)
  (bytes->string/utf-8 (bytes/charset->bytes/utf-8 bytes charset)))

(define (string->bytes/charset string charset)
  (bytes/utf-8->bytes/charset (string->bytes/utf-8 string) charset))

(define (char-latin-1? c)
  (< 0 (char->integer c) 256))

(define (char-ascii? c)
  (< 0 (char->integer c) 128))

(define (string-char-or? s test?)
  (define (helper len i)
    (if (= len i) #f
        (if (test? (string-ref s i)) #t
            (helper len (add1 i)))))
  (helper (string-length s) 0)) 

(define (string-char-and? s test?)
  (define (helper len i)
    (if (= len i) #t
        (if (not (test? (string-ref s i))) #f
            (helper len (add1 i)))))
  (helper (string-length s) 0))

(define (char-type c)
  (let ((i (char->integer c))) 
    (cond ((< i 128) 'ascii)
          ((< i 256) 'latin-1)
          (else 'unicode))))

(define (string-type s)
  (define (helper len i prev)
    (if (= len i) prev
        (let ((type (char-type (string-ref s i))))
          (case type 
            ((unicode) type)
            ((latin-1) 
             (helper len (add1 i) (case prev
                                    ((ascii) type)
                                    (else prev))))
            (else (helper len (add1 i) prev))))))
  (helper (string-length s) 0 'ascii))

(define (string-latin-1? s)
  (string-char-and? s char-latin-1?))

(define (string-ascii? s)
  (string-char-and? s char-ascii?))

(define (char->bytes c)
  (string->bytes/utf-8 (string c)))

(define (split-string-by-bytes-count str num)
  (define (maker chars)
    (list->string (reverse chars)))
  (define (helper str i chars blen acc)
    (if (= i (string-length str)) ;; we are done here!!!...
        (reverse (if (null? chars) acc
                     (cons (maker chars) acc)))
        (let* ((c (string-ref str i))
               (count (char-utf-8-length c))) 
          (if (> (+ count blen) num) ;; we are done with this version....
              (if (= blen 0) ;; this means the character itself is greater than the count. 
                  (helper str (add1 i) '() 0 (cons (maker (cons c chars)) acc))
                  (helper str i '() 0 (cons (maker chars) acc)))
              (helper str (add1 i) (cons c chars) (+ count blen) acc)))))
  (helper str 0 '() 0 '()))

(provide/contract
 (char-ascii? (-> char? any)) 
 (char-latin-1? (-> char? any)) 
 (string-char-or? (-> string? (-> char? any) any)) 
 (string-char-and? (-> string? (-> char? any) any)) 
 (string-latin-1? (-> string? any)) 
 (string-ascii? (-> string? any)) 
 (char-type (-> char? any)) 
 (string-type (-> string? any))
 (split-string-by-bytes-count (-> string? exact-positive-integer? (listof string?)))
 (port->bytes/charset (-> input-port? string? string? any)) 
 (bytes->bytes/charset (-> bytes? string? string? bytes?))
 (bytes/charset->bytes/utf-8 (-> bytes? string? bytes?))
 (bytes/utf-8->bytes/charset (-> bytes? string? bytes?))
 (bytes/charset->string (-> bytes? string? string?))
 (string->bytes/charset (-> string? string? bytes?)) 
 )