#lang racket/base

(require net/uri-codec
         net/url
         racket/port
         racket/contract)

;; Programmatic access to the closure compiler service.
;; http://code.google.com/closure/compiler/docs/api-tutorial1.html

(provide/contract [closure-compile ((string?) 
                                    ((one-of/c 'whitespace
                                               'simple
                                               'advanced)) . ->* . string?)])



(define (closure-compile code [compilation-level 'simple])
  (let ([marks (current-continuation-marks)])
    (let ([compiled (do-post code compilation-level)])
      (cond
        [(maybe-erroneous? compiled)
         (let ([errors (do-post code compilation-level "errors")])
           (cond [(string=? errors "\n")
                  compiled]
                 [else
                  (raise (make-exn:fail (format "closure-compile: ~a"
                                                errors)
                                        marks))]))]
        [else
         compiled]))))


(define (maybe-erroneous? result)
  (string=? result "\n"))


;; Optimization levels.
;; compilation-level->string: symbol -> string
(define (compilation-level->string level)
  (case level
    [(whitespace) "WHITESPACE_ONLY"]
    [(simple) "SIMPLE_OPTIMIZATIONS"]
    [(advanced) "ADVANCED_OPTIMIZATIONS"]))



(define (do-post code compilation-level (output-info "compiled_code"))
  (let ([input-port
         (post-pure-port (string->url "http://closure-compiler.appspot.com/compile")
                           (encode-parameters code 
                                              (compilation-level->string compilation-level)
                                              output-info)
                           (list "Content-type: application/x-www-form-urlencoded"))])    
    (let ([result (port->string input-port)])
      (close-input-port input-port)
      result)))
  


  

;; encode-parameters: string string -> bytes
(define (encode-parameters code compilation-level output-info)
  (string->bytes/utf-8
   (alist->form-urlencoded `((js_code . ,code)
                             (compilation_level . ,compilation-level) 
                             (output_format . "text")
                             (output_info . ,output-info)))))