#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; NET.plt
;;
;; abstraction of common network behaviors and services
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; q.ss - q parser as defined in rfc2047
;; yc 2/13/2010 - first version
(require "depend.ss"
         )
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; p-preserve? determines whether the byte shall be preservd or converted...
(define (q-preserve? b)
  (or (<= (char->integer #\A) b (char->integer #\Z))
      (<= (char->integer #\a) b (char->integer #\z))
      (<= (char->integer #\0) b (char->integer #\9))
      (memq b (map char->integer '(#\! #\* #\+ #\- #\/ #\= #\_)))))

;; q-convert? any byte that does not fall into the preserve range.
(define (q-convert? b)
  (not (q-preserve? b))) 

;; integer->hex-string
;; converts an integer to hex value.. I always have a bunch of hex thing to do...
(define (integer->hex-string i)
  (define (helper str)
    (if (= (string-length str) 1)
        (string-append "0" str)
        str))
  (helper (format "~x" i)))

;; byte->q-bytes
;; coverting a single byte into a quoted-printable bytes
(define (byte->q-bytes b)
  (bytes->list (string->bytes/utf-8
                (format "=~a" (integer->hex-string b)))))

;; q-encode-byte
;; the parser that encodes quoted-printable.
(define p:q-encode-byte (choice (byte-when q-preserve?)
                                (seq v <- (byte-when q-convert?)
                                     (return (byte->q-bytes v)))))

;; q-encode-bytes
;; encode for multiple bytes
(define p:q-encode-bytes (seq bytes <- (zero-many p:q-encode-byte)
                              (return (list->bytes (flatten bytes)))))

;; q-encode
;; the encoder
(define q-encode (make-reader p:q-encode-bytes))

;; q-encoded
;; parsing for hexdecimal
(define p:q-encoded (seq #"=" h1 <- hexdecimal h2 <- hexdecimal
                       (return (string->number (format "#x~a~a" h1 h2)))))

;; q-encoded-byte
;; parsing for quoted-printable byte
(define p:q-decode-byte (choice p:q-encoded any-byte))

;; q-encoded-bytes
;; parsing for a string of quoted-printable bytes
(define p:q-decode-bytes (seq v <- (zero-many p:q-decode-byte)
                            (return (list->bytes v))))

;; q-decode
;; q decoder
(define q-decode (make-reader p:q-decode-bytes))


(provide/contract 
 (q-decode Reader/c)
 (q-encode Reader/c))