#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MIME.plt
;;
;; an extensible MIME framework.
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; type.ss - interface to a mime.types parser & database.
;; yc 2/9/2010 - add the ability to save to the an user-specific mime file!!.
(require "depend.ss"
         ) 

;; the default mime.types database.
(define mime.types (or (getenv "BZLIB_MIME_TYPES")
                       (build-path (this-expression-source-directory) "mime.types"))) 

(define mime.types.out (or (getenv "BZLIB_MIME_TYPES_OUT")
                           (build-path (this-expression-source-directory) 
                                       "mime.types.out"))) 

(define not-line-term (char-not-in '(#\return #\newline)))

(define comment-line (seq #\# (zero-many not-line-term) (return #f)))

(define term (seq chars <- (one-many (choice alphanumeric #\/ #\+ #\. #\- #\_))
                 (return (list->string chars))))

(define mime-spec-line (choice comment-line 
                               (tokens mime-type <- term 
                                       extensions <- (zero-many (token term))
                                       (zero-one comment-line #f)
                                       (return (if (null? extensions)
                                                   #f
                                                   (cons mime-type extensions))))))

(define read-mime-spec-line (make-reader mime-spec-line))

(define (read-mime-types path)
  (define (line-helper type exts hash)
    (if (null? exts)
        hash
        (line-helper type (cdr exts) (hash-set hash (car exts) type))))
  (define (helper lst hash) ;; what do we want to do???
    (if (null? lst)
        hash
        (helper (cdr lst) (line-helper (caar lst) (cdar lst) hash))))
  (define (helper1 lst hash)
    (identity lst))
  (helper (filter identity (map read-mime-spec-line (file->lines path)))
           (make-immutable-hash '())))

(define (serialize-mime-types! hash path) 
  (call-with-output-file path (curry write hash) #:exists 'replace))

(define (deserialize-mime-types path)
  (call-with-input-file path read))

(define mime-types (make-parameter (make-immutable-hash '())))

(define (path->mime-type path (default "application/octet-stream")) 
  (hash-ref (mime-types) (bytes->string/utf-8 (filename-extension path)) default))

(define (mime-types-add! extension type) 
  (mime-types (hash-set (mime-types) (string-downcase extension)
                        (string-downcase type)))) 

(define (mime-types-save! (path mime.types.out)) 
  (serialize-mime-types! (mime-types) path))

(define (mime-types-load! (path mime.types.out))
  (mime-types (deserialize-mime-types path)))

(define (mime-types-del! extension type)
  (mime-types (hash-remove (mime-types) (string-downcase extension))))

(mime-types-load!)

(provide mime-types-save!
         mime-types-add!
         mime-types
         mime-types-del!
         mime-types-load!
         read-mime-types
         serialize-mime-types!
         deserialize-mime-types
         path->mime-type
         )