#lang racket/base
(require racket/contract
racket/runtime-path
racket/port)
(define java-path (find-executable-path "java"))
(define-runtime-path jar-path "compiler.jar")
(provide/contract
[closure-compile ((string?)
((one-of/c 'whitespace
'simple
'advanced)) . ->* . string?)])
(unless (path? java-path)
(error 'closure-compile "Unable to find Java in the current PATH."))
(define (closure-compile code [compilation-level 'simple])
(let ([marks (current-continuation-marks)]
[compiled-code-port (open-output-string)]
[error-port (open-output-string)])
(raw-compile-js (open-input-string code)
compiled-code-port
error-port
#:compilation-level compilation-level)
(let ([compiled (get-output-string compiled-code-port)])
(cond
[(maybe-erroneous? compiled)
(let ([errors (get-output-string error-port)])
(cond [(string=? errors "")
compiled]
[else
(raise (make-exn:fail (format "closure-compile: ~a" errors)
marks))]))]
[else
compiled]))))
(define (maybe-erroneous? result)
(string=? result ""))
(define (compilation-level->string level)
(case level
[(whitespace) "WHITESPACE_ONLY"]
[(simple) "SIMPLE_OPTIMIZATIONS"]
[(advanced) "ADVANCED_OPTIMIZATIONS"]))
(define (raw-compile-js ip op err
#:compilation-level (compilation-level 'simple))
(let-values
([(subp inp outp errp)
(subprocess #f #f #f
java-path "-jar" jar-path
"--compilation_level" (compilation-level->string
compilation-level))])
(thread (lambda ()
(copy-port ip outp)
(close-output-port outp)))
(thread (lambda ()
(copy-port inp op)))
(thread (lambda ()
(copy-port errp err)))
(subprocess-wait subp)))