#lang racket/base

(require "assemble.rkt"
         "quote-cdata.rkt"
         "../logger.rkt"
         "../make/make.rkt"
         "../make/make-structs.rkt"
         "../parameters.rkt"
         "../compiler/expression-structs.rkt"
         "../parser/path-rewriter.rkt"
         "../parser/parse-bytecode.rkt"
         "../resource/structs.rkt"
         racket/match
         racket/list
         racket/promise
         racket/set
         racket/path
         (prefix-in query: "../lang/js/query.rkt")
         (prefix-in resource-query: "../resource/query.rkt")
         (planet dyoo/closure-compile:1:1)
         (prefix-in runtime: "get-runtime.rkt")
         (prefix-in racket: racket/base))


;; TODO: put proper contracts here


(provide package
         package-anonymous
         package-standalone-xhtml
         get-inert-code
         get-standalone-code
         write-standalone-code
         get-runtime
         write-runtime
         current-on-resource
         get-html-template)



;; notify: string (listof any)* -> void
;; Print out log message during the build process.
(define (notify msg . args)
  (displayln (apply format msg args)))



(define current-on-resource
  (make-parameter (lambda (r)
                    (log-debug "Resource ~s should be written"
                               (resource-path r))
                    (void))))




(define-struct js-impl (name ;; symbol
                        real-path ;; path
                        src ;; string
                        )
  #:transparent)


;; Packager: produce single .js files to be included to execute a
;; program.



(define (package-anonymous source-code
                           #:should-follow-children? should-follow?
                           #:output-port op)
  (fprintf op "(function() {\n")
  (package source-code
           #:should-follow-children? should-follow?
           #:output-port op)
  (fprintf op " return invoke; })\n"))



;; source-is-javascript-module?: Source -> boolean
;; Returns true if the source looks like a Javascript-implemented module.
(define (source-is-javascript-module? src)
  (cond
    [(StatementsSource? src)
     #f]
    [(MainModuleSource? src)
     (source-is-javascript-module?
      (MainModuleSource-source src))]
    [(ModuleSource? src)
     (query:has-javascript-implementation?
      `(file ,(path->string (ModuleSource-path src))))]
    [(SexpSource? src)
     #f]
    [(UninterpretedSource? src)
     #f]))

(define (source-resources src)
  (cond
    [(StatementsSource? src)
     empty]
    [(MainModuleSource? src)
     (source-resources
      (MainModuleSource-source src))]
    [(ModuleSource? src)
     (resource-query:query
      `(file ,(path->string (ModuleSource-path src))))]
    [(SexpSource? src)
     empty]
    [(UninterpretedSource? src)
     empty]))



;; get-javascript-implementation: source -> UninterpretedSource
(define (get-javascript-implementation src)
  
  (define (get-provided-name-code bytecode)
    (match bytecode
      [(struct Top [_ (struct Module (name path prefix requires provides code))])
       (apply string-append
              (map (lambda (p)
                     (format "modrec.namespace[~s] = exports[~s];\n"
                             (symbol->string (ModuleProvide-internal-name p))
                             (symbol->string (ModuleProvide-external-name p))))
                   provides))]
      [else
       ""]))
  (cond
    [(StatementsSource? src)
     (error 'get-javascript-implementation src)]
    [(MainModuleSource? src)
     (get-javascript-implementation (MainModuleSource-source src))]
    [(ModuleSource? src)
     (let ([name (rewrite-path (ModuleSource-path src))]
           [text (query:query `(file ,(path->string (ModuleSource-path src))))]
           [module-requires (query:lookup-module-requires (ModuleSource-path src))]
           [bytecode (parse-bytecode (ModuleSource-path src))])
       (when (not (empty? module-requires))
         (log-debug "~a requires ~a"
                    (ModuleSource-path src)
                    module-requires))
       (let ([module-body-text
              (format "
             if(--MACHINE.callsBeforeTrampoline<0) { throw arguments.callee; }
             var modrec = MACHINE.modules[~s];
             var exports = {};
             modrec.isInvoked = true;
             (function(MACHINE, RUNTIME, EXPORTS){~a})(MACHINE, plt.runtime, exports);
             ~a
             modrec.privateExports = exports;
             return MACHINE.control.pop().label(MACHINE);"
                      (symbol->string name)
                      text
                      (get-provided-name-code bytecode))])
         
         (make-UninterpretedSource
          (format "
MACHINE.modules[~s] =
    new plt.runtime.ModuleRecord(~s,
        function(MACHINE) {
            ~a
        });
"
                  (symbol->string name)
                  (symbol->string name)
                  (assemble-modinvokes+body module-requires module-body-text))
          
          (map (lambda (p) (make-ModuleSource (normalize-path p)))
               module-requires))))]
    
    
    [(SexpSource? src)
     (error 'get-javascript-implementation)]
    [(UninterpretedSource? src)
     (error 'get-javascript-implementation)]))


(define (assemble-modinvokes+body paths after)
  (cond
    [(empty? paths)
     after]
    [(empty? (rest paths))
     (assemble-modinvoke (first paths) after)]
    [else
     (assemble-modinvoke (first paths)
                         (assemble-modinvokes+body (rest paths) after))]))


(define (assemble-modinvoke path after)
  (let ([name (rewrite-path (path->string path))]
        [afterName (gensym 'afterName)])
    (format "var ~a = function() { ~a };
             if (! MACHINE.modules[~s].isInvoked) {
                 MACHINE.modules[~s].internalInvoke(MACHINE,
                                            ~a,
                                            MACHINE.params.currentErrorHandler);
             } else {
                 ~a();
             }"
            afterName
            after
            (symbol->string name)
            (symbol->string name)
            afterName
            afterName)))




;; package: Source (path -> boolean) output-port -> void

;; Compile package for the given source program.
;;
;; should-follow-children?  indicates whether we should continue
;; following module paths of a source's dependencies.
;;
;; The generated output defines a function called 'invoke' with
;; four arguments (MACHINE, SUCCESS, FAIL, PARAMS).  When called, it will
;; execute the code to either run standalone expressions or
;; load in modules.
(define (package source-code
                 #:should-follow-children? should-follow?
                 #:output-port op)
  (define resources (set))
  
  
  ;; wrap-source: source -> source
  ;; Translate all JavaScript-implemented sources into uninterpreted sources;
  ;; we'll leave its interpretation to on-visit-src.
  (define (wrap-source src)
    (log-debug "Checking if the source has a JavaScript implementation")
    (cond
      [(source-is-javascript-module? src)
       (log-debug "Replacing implementation with JavaScript one.")
       (get-javascript-implementation src)]
      [else
       src]))
  
  
  (define (on-visit-src src ast stmts)
    ;; Record the use of resources on source module visitation...
    (set! resources (set-union resources
                               (list->set (source-resources src))))

    (fprintf op "\n// ** Visiting ~a\n" (source-name src))
    (cond
      [(UninterpretedSource? src)
       (fprintf op "~a" (UninterpretedSource-datum src))]
      [else
       (assemble/write-invoke stmts op)
       (fprintf op "(MACHINE, function() { ")]))
  
  
  (define (after-visit-src src ast stmts)
    (cond
      [(UninterpretedSource? src)
       (void)]
      [else
       (fprintf op " }, FAIL, PARAMS);")]))
  
  
  (define (on-last-src)
    (fprintf op "plt.runtime.setReadyTrue();")
    (fprintf op "SUCCESS();"))
  
  
  (define packaging-configuration
    (make-Configuration
     wrap-source
     
     should-follow?
     
     ;; on
     on-visit-src
     
     ;; after
     after-visit-src
     
     ;; last
     on-last-src))
  
  (fprintf op "var invoke = (function(MACHINE, SUCCESS, FAIL, PARAMS) {")
  (fprintf op "    plt.runtime.ready(function() {")
  (fprintf op "plt.runtime.setReadyFalse();")
  (make (list (make-MainModuleSource source-code))
        packaging-configuration)
  (fprintf op "    });");
  (fprintf op "});\n")
  
  (for ([r resources])
    ((current-on-resource) r)))




;; package-standalone-xhtml: X output-port -> void
(define (package-standalone-xhtml source-code op)
  (display *header* op)
  (display (quote-cdata
            (string-append (get-runtime)
                           (get-inert-code source-code)
                           invoke-main-module-code)) op)
  (display *footer* op))



;; write-runtime: output-port -> void
(define (write-runtime op)
  
  (define (wrap-source src) src)
  (let ([packaging-configuration
         (make-Configuration
          
          wrap-source
          
          ;; should-follow-children?
          (lambda (src) #t)
          ;; on
          (lambda (src ast stmts)
            (assemble/write-invoke stmts op)
            (fprintf op "(MACHINE, function() { "))
          
          ;; after
          (lambda (src ast stmts)
            (fprintf op " }, FAIL, PARAMS);"))
          
          ;; last
          (lambda ()
            (fprintf op "SUCCESS();")))])
    
    (display (runtime:get-runtime) op)
    
    (newline op)
    (fprintf op "(function(MACHINE, SUCCESS, FAIL, PARAMS) {")
    (make (list only-bootstrapped-code) packaging-configuration)
    (fprintf op "})(plt.runtime.currentMachine,\nfunction(){ plt.runtime.setReadyTrue(); },\nfunction(){},\n{});\n")))



(define (compress x)
  (cond [(current-compress-javascript?)
         (log-debug "compressing javascript...")
         (closure-compile x)]
        [else
         (log-debug "not compressing javascript...")
         x]))



(define *the-runtime*
  (delay (let ([buffer (open-output-string)])
           (write-runtime buffer)
           (compress
            (get-output-string buffer)))))


;; get-runtime: -> string
(define (get-runtime)
  (force *the-runtime*))





;; *header* : string
(define *header*
  #<<EOF
<!DOCTYPE html>
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
  <head>
    <meta name="viewport" content="initial-scale=1.0, width=device-width, height=device-height, minimum-scale=1.0, maximum-scale=1.0, user-scalable=no" />
    <meta charset="utf-8"/>
    <title></title>
  </head>
  <script>

EOF
  )


;; get-html-template: string -> string
(define (get-html-template js)
  (format #<<EOF
<!DOCTYPE html>
<html>
  <head>
    <meta name="viewport" content="initial-scale=1.0, width=device-width, height=device-height, minimum-scale=1.0, maximum-scale=1.0, user-scalable=no" />
    <meta charset="utf-8"/>
    <title></title>
  </head>
  <script src="~a"></script>
  <script>
var invokeMainModule = function() {
    var MACHINE = plt.runtime.currentMachine;
    invoke(MACHINE,
           function() {
                var startTime = new Date().valueOf();
                plt.runtime.invokeMains(
                    MACHINE,
                    function() {
                        // On main module invokation success:
                        var stopTime = new Date().valueOf();                                
                        if (window.console && window.console.log) {
                            window.console.log('evaluation took ' + (stopTime - startTime) + ' milliseconds');
                        }
                    },
                    function(MACHINE, e) {
                        var contMarkSet, appNames, i, appName;
                        // On main module invokation failure
                        if (window.console && window.console.log) {
                            window.console.log(e.stack || e);
                        }
                        
                        MACHINE.params.currentErrorDisplayer(
                             MACHINE, $(plt.baselib.format.toDomNode(e.stack || e)).css('color', 'red'));

                        if (e.hasOwnProperty('racketError') &&
                            plt.baselib.exceptions.isExn(e.racketError)) {
                            contMarkSet = plt.baselib.exceptions.exnContMarks(e.racketError);
                            if (contMarkSet) {
                                 appNames = contMarkSet.ref(plt.runtime.getTracedAppKey(MACHINE));
                                 while (plt.baselib.lists.isPair(appNames)) {
                                     appName = appNames.first;
                                     MACHINE.params.currentErrorDisplayer(
                                        MACHINE,
                                        $('<div/>').text('  at ' + appName.elts[0] +
                                                         ', line ' + appName.elts[2] +
                                                         ', column ' + appName.elts[3])
                                                   .addClass('stacktrace')
                                                   .css('margin-left', '10px')
                                                   .css('whitespace', 'pre')
                                                   .css('color', 'red'));
                                     appNames = appNames.rest;
                                 }
                            }
                        }
                    })},
           function() {
               // On module loading failure
               if (window.console && window.console.log) {
                   window.console.log(e.stack || e);
               }                       
           },
           {});
};
  $(document).ready(invokeMainModule);
  </script>
  </head>
  <body>
  </body>
  </html>
EOF

  js
  ))


;; get-inert-code: source -> string
(define (get-inert-code source-code)
  (let ([buffer (open-output-string)])
    (package source-code
             #:should-follow-children? (lambda (src) #t)
             #:output-port buffer)
    (compress
     (get-output-string buffer))))



;; get-standalone-code: source -> string
(define (get-standalone-code source-code)
  (let ([buffer (open-output-string)])
    (write-standalone-code source-code buffer)
    (compress
     (get-output-string buffer))))


;; write-standalone-code: source output-port -> void
(define (write-standalone-code source-code op)
  (package-anonymous source-code
                     #:should-follow-children? (lambda (src) #t)
                     #:output-port op)
  (fprintf op "()(plt.runtime.currentMachine, function() {}, function() {}, {});\n"))





(define invoke-main-module-code
  #<<EOF
var invokeMainModule = function() {
    var MACHINE = plt.runtime.currentMachine;
    invoke(MACHINE,
           function() {
                var startTime = new Date().valueOf();
                plt.runtime.invokeMains(
                    MACHINE,
                    function() {
                        // On main module invokation success:
                        var stopTime = new Date().valueOf();                                
                        if (window.console && window.console.log) {
                            window.console.log('evaluation took ' + (stopTime - startTime) + ' milliseconds');
                        }
                    },
                    function(MACHINE, e) {
                        var contMarkSet, appNames, i, appName;
                        // On main module invokation failure
                        if (window.console && window.console.log) {
                            window.console.log(e.stack || e);
                        }
                        
                        MACHINE.params.currentErrorDisplayer(
                             MACHINE, $(plt.baselib.format.toDomNode(e.stack || e)).css('color', 'red'));

                        if (e.hasOwnProperty('racketError') &&
                            plt.baselib.exceptions.isExn(e.racketError)) {
                            contMarkSet = plt.baselib.exceptions.exnContMarks(e.racketError);
                            if (contMarkSet) {
                                 appNames = contMarkSet.ref(plt.runtime.getTracedAppKey(MACHINE));
                                 while (plt.baselib.lists.isPair(appNames)) {
                                     appName = appNames.first;
                                     MACHINE.params.currentErrorDisplayer(
                                        MACHINE,
                                        $('<div/>').text('  at ' + appName.elts[0] +
                                                         ', line ' + appName.elts[2] +
                                                         ', column ' + appName.elts[3])
                                                   .addClass('stacktrace')
                                                   .css('margin-left', '10px')
                                                   .css('whitespace', 'pre')
                                                   .css('color', 'red'));
                                     appNames = appNames.rest;
                                 }
                            }
                        }
                    })},
           function() {
               // On module loading failure
               if (window.console && window.console.log) {
                   window.console.log(e.stack || e);
               }                       
           },
           {});
};
  
  $(document).ready(invokeMainModule);
EOF
  )

(define *footer*
  #<<EOF
  </script>
  <body></body>
</html>
EOF
  )