separating the command line from its functions
This commit is contained in:
Danny Yoo
parent
6d7f75fab8
commit
ff796e9ff0
3
info.rkt
3
info.rkt
|
|
@ -13,4 +13,5 @@
|
|||
(define scribblings '(("scribblings/manual.scrbl")))
|
||||
(define compile-omit-paths '("tests"
|
||||
"examples"
|
||||
"experiments"))
|
||||
"experiments"
|
||||
"simulator"))
|
||||
|
|
@ -516,9 +516,9 @@ EOF
|
|||
(define-predicate natural? Natural)
|
||||
|
||||
(: ensure-natural (Any -> Natural))
|
||||
(define (ensure-natural x)
|
||||
(if (natural? x)
|
||||
x
|
||||
(define (ensure-natural n)
|
||||
(if (natural? n)
|
||||
n
|
||||
(error 'ensure-natural)))
|
||||
|
||||
|
||||
|
|
|
|||
88
whalesong-helpers.rkt
Normal file
88
whalesong-helpers.rkt
Normal file
|
|
@ -0,0 +1,88 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/match
|
||||
racket/file
|
||||
racket/path
|
||||
racket/port
|
||||
"make/make-structs.rkt"
|
||||
"js-assembler/package.rkt"
|
||||
"resource/structs.rkt"
|
||||
"logger.rkt")
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
||||
(define current-verbose? (make-parameter #f))
|
||||
(define current-output-dir (make-parameter (build-path (current-directory))))
|
||||
(define current-write-resources? (make-parameter #t))
|
||||
|
||||
(define (same-file? p1 p2)
|
||||
(or (equal? (normalize-path p1) (normalize-path p2))
|
||||
(bytes=? (call-with-input-file p1 port->bytes)
|
||||
(call-with-input-file p2 port->bytes))))
|
||||
|
||||
|
||||
(define (turn-on-logger!)
|
||||
(void (thread (lambda ()
|
||||
(let ([receiver
|
||||
(make-log-receiver whalesong-logger
|
||||
(if (current-verbose?)
|
||||
'debug
|
||||
'info))])
|
||||
(let loop ()
|
||||
(let ([msg (sync receiver)])
|
||||
(match msg
|
||||
[(vector level msg data)
|
||||
(fprintf (current-error-port)"~a: ~a\n" level msg)
|
||||
(flush-output (current-error-port))]))
|
||||
(loop)))))))
|
||||
|
||||
(define (build f)
|
||||
(turn-on-logger!)
|
||||
(let-values ([(base filename dir?)
|
||||
(split-path f)])
|
||||
(let ([output-filename
|
||||
(build-path
|
||||
(regexp-replace #rx"[.](rkt|ss)$"
|
||||
(path->string filename)
|
||||
".xhtml"))])
|
||||
(unless (directory-exists? (current-output-dir))
|
||||
(make-directory* (current-output-dir)))
|
||||
(parameterize ([current-on-resource
|
||||
(lambda (r)
|
||||
(log-info (format "Writing resource ~s" (resource-path r)))
|
||||
(cond
|
||||
[(file-exists? (build-path (current-output-dir)
|
||||
(resource-key r)))
|
||||
(cond [(same-file? (build-path (current-output-dir)
|
||||
(resource-key r))
|
||||
(resource-path r))
|
||||
(void)]
|
||||
[else
|
||||
(error 'whalesong "Unable to write resource ~s; this will overwrite a file"
|
||||
(build-path (current-output-dir)
|
||||
(resource-key r)))])]
|
||||
[else
|
||||
(copy-file (resource-path r)
|
||||
(build-path (current-output-dir)
|
||||
(resource-key r)))]))])
|
||||
(call-with-output-file* (build-path (current-output-dir) output-filename)
|
||||
(lambda (op)
|
||||
(package-standalone-xhtml
|
||||
(make-ModuleSource (build-path f))
|
||||
op))
|
||||
#:exists 'replace)))))
|
||||
|
||||
|
||||
|
||||
(define (print-the-runtime)
|
||||
(turn-on-logger!)
|
||||
(display (get-runtime) (current-output-port)))
|
||||
|
||||
|
||||
|
||||
(define (get-javascript-code filename)
|
||||
(turn-on-logger!)
|
||||
(display (get-standalone-code
|
||||
(make-ModuleSource (build-path filename)))
|
||||
(current-output-port)))
|
||||
124
whalesong.rkt
124
whalesong.rkt
|
|
@ -1,19 +1,16 @@
|
|||
#!/usr/bin/env racket
|
||||
#lang racket/base
|
||||
|
||||
(require racket/list
|
||||
racket/string
|
||||
racket/match
|
||||
racket/file
|
||||
racket/path
|
||||
racket/port
|
||||
"make/make-structs.rkt"
|
||||
"js-assembler/package.rkt"
|
||||
"resource/structs.rkt"
|
||||
"private/command.rkt"
|
||||
"logger.rkt"
|
||||
(require "private/command.rkt"
|
||||
"parameters.rkt"
|
||||
raco/command-name)
|
||||
"whalesong-helpers.rkt")
|
||||
|
||||
;; Command line for running Whalesong.
|
||||
|
||||
|
||||
;; TODO: we may want to adopt this as a raco command, as described in:
|
||||
;;
|
||||
;; http://docs.racket-lang.org/raco/command.html
|
||||
|
||||
|
||||
;; Usage:
|
||||
|
|
@ -34,14 +31,10 @@
|
|||
|
||||
|
||||
|
||||
(define current-verbose? (make-parameter #f))
|
||||
(define current-resource-dir (make-parameter (build-path (current-directory))))
|
||||
(define current-write-resources? (make-parameter #t))
|
||||
|
||||
|
||||
(define (at-toplevel)
|
||||
(svn-style-command-line
|
||||
#:program "whalesong" ; (short-program+command-name)
|
||||
#:program "whalesong"
|
||||
#:argv (current-command-line-arguments)
|
||||
"The Whalesong command-line tool for compiling Racket to JavaScript"
|
||||
["build" "build a standalone xhtml package"
|
||||
|
|
@ -53,9 +46,12 @@
|
|||
[("--compress-javascript")
|
||||
("Compress JavaScript with Google Closure (requires Java)")
|
||||
(current-compress-javascript? #t)]
|
||||
|
||||
[("--dest-dir")
|
||||
dest-dir
|
||||
("Set destination directory (default: current-directory)")
|
||||
(current-output-dir dest-dir)]
|
||||
#:args (path)
|
||||
(do-the-build path)]
|
||||
(build path)]
|
||||
["get-runtime" "print the runtime library to standard output"
|
||||
"Prints the runtime JavaScript library that's used by Whalesong programs."
|
||||
#:once-each
|
||||
|
|
@ -65,7 +61,7 @@
|
|||
[("--compress-javascript")
|
||||
("Compress JavaScript with Google Closure (requires Java)")
|
||||
(current-compress-javascript? #t)]
|
||||
|
||||
|
||||
#:args ()
|
||||
(print-the-runtime)]
|
||||
["get-javascript" "Gets just the JavaScript code and prints it to standard output"
|
||||
|
|
@ -74,96 +70,14 @@
|
|||
[("-v" "--verbose")
|
||||
("Display verbose messages.")
|
||||
(current-verbose? #t)]
|
||||
|
||||
|
||||
[("--compress-javascript")
|
||||
("Compress JavaScript with Google Closure (requires Java)")
|
||||
(current-compress-javascript? #t)]
|
||||
|
||||
|
||||
|
||||
|
||||
#:args (file)
|
||||
(get-javascript-code file)]))
|
||||
|
||||
|
||||
|
||||
|
||||
(define (turn-on-logger!)
|
||||
(void (thread (lambda ()
|
||||
(let ([receiver
|
||||
(make-log-receiver whalesong-logger
|
||||
(if (current-verbose?)
|
||||
'debug
|
||||
'info))])
|
||||
(let loop ()
|
||||
(let ([msg (sync receiver)])
|
||||
(match msg
|
||||
[(vector level msg data)
|
||||
(fprintf (current-error-port)"~a: ~a\n" level msg)
|
||||
(flush-output (current-error-port))]))
|
||||
(loop)))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (same-file? p1 p2)
|
||||
(or (equal? (normalize-path p1) (normalize-path p2))
|
||||
(bytes=? (call-with-input-file p1 port->bytes)
|
||||
(call-with-input-file p2 port->bytes))))
|
||||
|
||||
|
||||
(define (do-the-build f)
|
||||
(turn-on-logger!)
|
||||
(let-values ([(base filename dir?)
|
||||
(split-path f)])
|
||||
(let ([output-filename
|
||||
(build-path
|
||||
(regexp-replace #rx"[.](rkt|ss)$"
|
||||
(path->string filename)
|
||||
".xhtml"))])
|
||||
(parameterize ([current-on-resource
|
||||
(lambda (r)
|
||||
(make-directory* (current-resource-dir))
|
||||
(log-info (format "Writing resource ~s" (resource-path r)))
|
||||
(cond
|
||||
[(file-exists? (build-path (current-resource-dir)
|
||||
(resource-key r)))
|
||||
(cond [(same-file? (build-path (current-resource-dir)
|
||||
(resource-key r))
|
||||
(resource-path r))
|
||||
(void)]
|
||||
[else
|
||||
(error 'whalesong "Unable to write resource ~s; this will overwrite a file"
|
||||
(build-path (current-resource-dir)
|
||||
(resource-key r)))])]
|
||||
[else
|
||||
(copy-file (resource-path r)
|
||||
(build-path (current-resource-dir)
|
||||
(resource-key r)))]))])
|
||||
(call-with-output-file* output-filename
|
||||
(lambda (op)
|
||||
(package-standalone-xhtml
|
||||
(make-ModuleSource (build-path f))
|
||||
op))
|
||||
#:exists 'replace)))))
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (print-the-runtime)
|
||||
(turn-on-logger!)
|
||||
(display (get-runtime) (current-output-port)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (get-javascript-code filename)
|
||||
(turn-on-logger!)
|
||||
(display (get-standalone-code
|
||||
(make-ModuleSource (build-path filename)))
|
||||
(current-output-port)))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(at-toplevel)
|
||||
|
|
|
|||
|
|
@ -134,7 +134,7 @@ var adaptWorldFunction = function(worldFunction) {
|
|||
// FIXME: do error trapping
|
||||
console.log(err);
|
||||
}].concat([].slice.call(arguments, 0, arguments.length - 1)));
|
||||
}
|
||||
};
|
||||
};
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user