#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; NET.plt
;;
;; abstraction of common network behaviors and services
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; encoded-word.ss - parser for rfc2047 encoded word
;; yc 2/13/2010 - first version
(require "depend.ss"
         "q.ss"
         "b.ss"
         )

;; ENCODED-WORD
;; (-> string? string? string? string?)
(define (encode-encoded-word charset encode str)
  (format "=?~a?~a?~a?=" 
          (string-downcase charset)
          (string-upcase encode)
          ((cond ((string-ci=? encode "q") q-encode)
                 ((string-ci=? encode "b") b-encode)) 
           (string->bytes/charset str charset))))

(define (encode-encoded-word* charset encode str) 
  (string-join (map (curry encode-encoded-word charset encode)
                    (split-string-by-bytes-count str 48))
               "\r\n "))

;; (-> string? string? string? string?)
(define (decode-encoded-word charset encode str) 
  (bytes/charset->string ((cond ((string-ci=? encode "q") q-decode)
                                ((string-ci=? encode "b") b-decode))
                          (string->bytes/utf-8 str))
                         (string-downcase charset) 
                         ))

(define p:token (seq v <- (one-many (char-not= #\?)) (return (list->string v)))) 

(define p:encoded-text (seq v <- (one-many (char-not-in '(#\? #\space))) 
                            (return (list->string v))))

(define p:encoding (seq e <- (choice #\b #\B #\q #\Q) (return (string e))))

(define p:encoded-word/one (seq "=?" 
                                charset <- p:token 
                                "?"
                                encoding <- p:encoding
                                "?" 
                                text <- p:encoded-text 
                                "?="
                                (return (decode-encoded-word charset encoding text))))

(define p:quoted-encoded-word (seq #\" 
                                   w <- p:encoded-word/one 
                                   #\"
                                   (return w)))

(define p:encoded-word (seq words <- (one-many (token/pre p:encoded-word/one))
                            (return (string-join words ""))))

;; what is unclear is why this thing would *fail*...!!!
#|
(define encoded-word (seq words <- (delimited encoded-word/one whitespaces 
                                              token/pre)
                           (return (string-join words ""))))
;;|#

;; having multiple encoded-word together means they are compressed together.
(define read-encoded-word (make-reader p:encoded-word #:eof? #f))


;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EXPORT
(provide/contract (p:encoded-word/one Parser/c)
                  (p:quoted-encoded-word Parser/c)
                  (p:encoded-word Parser/c)
                  (read-encoded-word Reader/c)
                  (decode-encoded-word (-> string? string? string? string?))
                  (encode-encoded-word (-> string? string? string? string?))
                  (encode-encoded-word* (-> string? string? string? string?))
                  )