forked from syndicate-lang/preserves
batch-compile
This commit is contained in:
parent
ef7cea09bf
commit
534018e3a4
|
@ -1,8 +1,11 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide batch-compile)
|
||||
|
||||
(require "../main.rkt")
|
||||
(require "../reader.rkt")
|
||||
(require racket/match)
|
||||
(require racket/pretty)
|
||||
(require (only-in racket/list index-of append-map remove-duplicates last drop-right))
|
||||
(require (only-in racket/string string-split string-prefix?))
|
||||
(require (only-in racket/file make-parent-directory*))
|
||||
|
@ -63,11 +66,43 @@
|
|||
module-path
|
||||
(file->schema full-input-path)))))
|
||||
|
||||
(define (batch-compile #:inputs inputs
|
||||
#:additional-modules [additional-modules (hash)]
|
||||
#:base-directory [base-directory #f]
|
||||
#:output-directory [output-directory #f]
|
||||
#:write-files? [write-files? #t])
|
||||
(expand-globs inputs
|
||||
base-directory
|
||||
output-directory
|
||||
(lambda (base-directory output-directory schemas)
|
||||
|
||||
(define index
|
||||
(for/fold [(index additional-modules)]
|
||||
[(s (in-list schemas))]
|
||||
(hash-set index (schema-module-path s) (schema-relative-output-path s))))
|
||||
|
||||
(define outputs
|
||||
(for/hash [(s (in-list schemas))]
|
||||
(values (schema-full-output-path s)
|
||||
(schema->module-stx (last (schema-module-path s))
|
||||
(lambda (module-path)
|
||||
(hash-ref index module-path #f))
|
||||
(schema-value s)
|
||||
#:filename (schema-full-output-path s)))))
|
||||
|
||||
(when write-files?
|
||||
(for [((output-path stx) (in-hash outputs))]
|
||||
(make-parent-directory* output-path)
|
||||
(with-output-to-file output-path #:exists 'replace
|
||||
(lambda () (pretty-write stx)))))
|
||||
|
||||
outputs)))
|
||||
|
||||
(module+ main
|
||||
(require racket/cmdline)
|
||||
(require racket/pretty)
|
||||
|
||||
(define output-directory #f)
|
||||
(define write-files? #t)
|
||||
(define stdout? #f)
|
||||
(define base-directory #f)
|
||||
(define additional-modules '())
|
||||
|
@ -78,6 +113,8 @@
|
|||
(set! output-directory directory)]
|
||||
["--stdout" "Prints each module to stdout one after the other instead of writing them to files in the `--output` directory"
|
||||
(set! stdout? #t)]
|
||||
["--no-write-files" "Disables generation of output to the filesystem"
|
||||
(set! write-files? #f)]
|
||||
["--base" directory "Base directory for sources (default: common prefix)"
|
||||
(set! base-directory directory)]
|
||||
#:multi
|
||||
|
@ -94,27 +131,21 @@
|
|||
#:args input-glob
|
||||
(set! inputs (map clean-input input-glob)))
|
||||
|
||||
(expand-globs inputs
|
||||
base-directory
|
||||
output-directory
|
||||
(lambda (base-directory output-directory schemas)
|
||||
(when (null? inputs)
|
||||
(error 'preserves-schema-rkt "No inputs specified."))
|
||||
|
||||
(define index (make-hash))
|
||||
(for [(s (in-list schemas))]
|
||||
(hash-set! index (schema-module-path s) (schema-relative-output-path s)))
|
||||
(for [(e (in-list additional-modules))]
|
||||
(hash-set! index (car e) (cadr e)))
|
||||
(define outputs
|
||||
(batch-compile #:inputs inputs
|
||||
#:additional-modules (for/hash [(e (in-list additional-modules))]
|
||||
(values (car e) (cadr e)))
|
||||
#:base-directory base-directory
|
||||
#:output-directory output-directory
|
||||
#:write-files? write-files?))
|
||||
|
||||
(define outputs
|
||||
(for/hash [(s (in-list schemas))]
|
||||
(values (schema-full-output-path s)
|
||||
(schema->module-stx (last (schema-module-path s))
|
||||
(lambda (module-path)
|
||||
(hash-ref index module-path #f))
|
||||
(schema-value s)
|
||||
#:filename (schema-full-output-path s)))))
|
||||
|
||||
(for [((output-path stx) (in-hash outputs))]
|
||||
(make-parent-directory* output-path)
|
||||
(with-output-to-file output-path #:exists 'replace
|
||||
(lambda () (pretty-write stx)))))))
|
||||
(when stdout?
|
||||
(for [((output-path stx) (in-hash outputs))]
|
||||
(printf ";;-----------------------------------------------------------------\n")
|
||||
(printf ";; ~a\n" output-path)
|
||||
(newline)
|
||||
(pretty-write stx)
|
||||
(newline))))
|
||||
|
|
Loading…
Reference in New Issue