d0d391d76b
The `--recompile-only` flag is intended to help dectect build problems, especially distribution builds where packages are supposed to be in built form.
223 lines
9.6 KiB
Racket
223 lines
9.6 KiB
Racket
#lang racket/base
|
|
|
|
;; Command-line parsing is in its own module because it has to be used
|
|
;; both in setup.ss (pre-zo, pre-cm) and setup-go.rkt (use zos and cm).
|
|
;; This means that command lines will be parsed twice.
|
|
|
|
(require racket/cmdline
|
|
raco/command-name
|
|
pkg/name
|
|
"private/command-name.rkt")
|
|
|
|
(provide parse-cmdline)
|
|
|
|
;; The result of parse-cmdline is three lists:
|
|
;; - An assoc list mapping flag symbols to booleans
|
|
;; (nearly all symbols correspond to parameter names
|
|
;; in setup-go.rkt)
|
|
;; - A list of specific collections
|
|
;; - A list of archives
|
|
|
|
(define (parse-cmdline argv)
|
|
|
|
(define x-specific-planet-packages '())
|
|
(define x-flags null)
|
|
(define (add-flags l)
|
|
(set! x-flags (append (reverse l) x-flags)))
|
|
|
|
(define-values (short-name long-name raco?) (get-names))
|
|
|
|
(define disable-action-flags
|
|
'((make-zo #f)
|
|
(call-install #f)
|
|
(call-post-install #f)
|
|
(make-launchers #f)
|
|
(make-info-domain #f)
|
|
(make-docs #f)
|
|
(check-dependencies #f)
|
|
(make-foreign-libs #f)))
|
|
|
|
;; Beware of the poor-man's duplicate of this command-line specification
|
|
;; in "main.rkt"!
|
|
(define-values (x-specific-collections x-specific-packages x-archives)
|
|
(command-line
|
|
#:program long-name
|
|
#:argv argv
|
|
#:help-labels
|
|
" --------------------------- collections --------------------------- "
|
|
" If no collection, package, or archive is specified, all are setup"
|
|
#:once-each
|
|
[("--only") "Set up only specified, even if none"
|
|
(add-flags '((make-only #t)))]
|
|
[("-l") => (lambda (flag . collections)
|
|
(check-collections short-name collections)
|
|
(cons 'collections (map list collections)))
|
|
'("Setup specified <collection>s" "collection")]
|
|
[("--pkgs") => (lambda (flag . pkgs)
|
|
(check-packages short-name pkgs)
|
|
(cons 'packages pkgs))
|
|
'("Setup collections in specified <pkg>s" "pkg")]
|
|
#:multi
|
|
[("-P") owner package-name maj min
|
|
"Setup specified PLaneT packages"
|
|
(set! x-specific-planet-packages (cons (list owner package-name maj min)
|
|
x-specific-planet-packages))]
|
|
#:once-each
|
|
[("--doc-index") "Rebuild documentation index along with specified"
|
|
(add-flags '((make-doc-index #t)))]
|
|
[("--tidy") "Clear references to removed items outside of specified"
|
|
(add-flags '((make-tidy #t)))]
|
|
#:help-labels
|
|
" ------------------------------ tasks ------------------------------ "
|
|
#:once-each
|
|
[("-c" "--clean") "Delete existing compiled files; implies -nxiIFDK"
|
|
(add-flags (append '((clean #t))
|
|
disable-action-flags))]
|
|
[("--fast-clean") "Like --clean, but non-bootstrapping (can fail)"
|
|
(add-flags (append '((clean #t))
|
|
disable-action-flags))]
|
|
[("-n" "--no-zo") "Do not create \".zo\" files"
|
|
(add-flags '((make-zo #f)))]
|
|
[("--trust-zos") "Trust existing \".zo\"s (use only with prepackaged \".zo\"s)"
|
|
(add-flags '((trust-existing-zos #t)))]
|
|
[("--recompile-only") "Fail if compilation must start from source"
|
|
(add-flags '((recompile-only #t)))]
|
|
[("-x" "--no-launcher") "Do not produce launcher programs"
|
|
(add-flags '((make-launchers #f)))]
|
|
[("-F" "--no-foreign-libs") "Do not install foreign libraries"
|
|
(add-flags '((make-foreign-libs #f)))]
|
|
[("--only-foreign-libs") "Disable actions except installing foreign libraries"
|
|
(add-flags (for/list ([fl (in-list disable-action-flags)]
|
|
#:unless (eq? (car fl) 'make-foreign-libs))
|
|
fl))]
|
|
[("-i" "--no-install") "Do not call collection-specific pre-installers"
|
|
(add-flags '((call-install #f)))]
|
|
[("-I" "--no-post-install") "Do not call collection-specific post-installers"
|
|
(add-flags '((call-post-install #f)))]
|
|
[("-d" "--no-info-domain") "Do not produce info-domain caches"
|
|
(add-flags '((make-info-domain #f)))]
|
|
[("-D" "--no-docs") "Do not compile .scrbl files and do not build documentation"
|
|
(add-flags '((make-docs #f)))]
|
|
[("--doc-pdf") dir "Build documentation PDFs, write to <dir>"
|
|
(add-flags `((doc-pdf-dest ,dir)))]
|
|
[("-K" "--no-pkg-deps") "Do not check package dependencies"
|
|
(add-flags '((check-dependencies #f)))]
|
|
[("--check-pkg-deps") "Check package dependencies when collections specified"
|
|
(add-flags '((always-check-dependencies #t)))]
|
|
[("--fix-pkg-deps") "Auto-repair package-dependency declarations"
|
|
(add-flags '((always-check-dependencies #t)
|
|
(fix-dependencies #t)))]
|
|
[("--unused-pkg-deps") "Check for unused package-dependency declarations"
|
|
(add-flags '((check-dependencies #t)
|
|
(check-unused-dependencies #t)))]
|
|
[("--chain") path dir "Select a continuation other than `setup/setup-go`"
|
|
;; This flag is handled by `setup/main`
|
|
(void)]
|
|
[("--boot") path dir "Like `--chain`, but use compiled only from <dir>"
|
|
;; This flag is handled by `setup/main`
|
|
(void)]
|
|
#:help-labels
|
|
" ------------------------------ users ------------------------------ "
|
|
#:once-each
|
|
[("-U" "--no-user") "Do not setup user-specific collections (implies --no-planet)"
|
|
(add-flags '((make-user #f) (make-planet #f)))]
|
|
[("--no-planet") "Do not setup PLaneT packages"
|
|
(add-flags '((make-planet #f)))]
|
|
[("--avoid-main") "Do not make main-installation files"
|
|
(add-flags '((avoid-main-installation #t)))]
|
|
[("--force-user-docs") "User-specific documentation even if matching installation"
|
|
(add-flags '((force-user-docs #t)))]
|
|
#:help-labels
|
|
" ------------------------------ modes ------------------------------ "
|
|
#:once-each
|
|
[("-j" "--jobs" "--workers") n "Use <n> parallel jobs"
|
|
(add-flags `((parallel-workers ,(string->number n))))]
|
|
#:once-any
|
|
[("--places") "Use places for parallel jobs"
|
|
(add-flags `((parallel-use-places #t)))]
|
|
[("--processes") "Use processes for parallel jobs"
|
|
(add-flags `((parallel-use-places #f)))]
|
|
#:once-each
|
|
[("-v" "--verbose") "See names of compiled files and info printfs"
|
|
(add-flags '((verbose #t)))]
|
|
[("-m" "--make-verbose") "See make and compiler usual messages"
|
|
(add-flags '((make-verbose #t)))]
|
|
[("-r" "--compile-verbose") "See make and compiler verbose messages"
|
|
(add-flags '((make-verbose #t)
|
|
(compiler-verbose #t)))]
|
|
[("--mode") mode "Select a compilation mode, such as \"errortrace\""
|
|
(add-flags `((compile-mode ,mode)))]
|
|
[("--fail-fast") "Trigger a break on the first error"
|
|
(add-flags '((fail-fast #t)))]
|
|
[("--error-out") file "On continuable error, create <file> and exit as success"
|
|
(add-flags `((next-error-out-file ,file)))]
|
|
[("--error-in") file "Check <file> for report of previous errors"
|
|
(add-flags `((previous-error-in-file ,file)))]
|
|
[("-p" "--pause") "Pause at the end if there are any errors"
|
|
(add-flags '((pause-on-errors #t)))]
|
|
#:help-labels
|
|
" ---------------------------- archives ----------------------------- "
|
|
#:once-each
|
|
[("-A") => (λ (flag . archives)
|
|
(cons 'archives archives))
|
|
'("Unpack and install <archive>s" "archive")]
|
|
[("--force") "Treat version mismatches for archives as mere warnings"
|
|
(add-flags '((force-unpacks #t)))]
|
|
[("-a" "--all-users") "Install archives to main (not user-specific) installation"
|
|
(add-flags '((all-users #t)))]
|
|
#:help-labels
|
|
" ------------------------------ misc ------------------------------- "
|
|
|
|
|
|
#:handlers
|
|
(lambda (collections/pkgs/archives . rest)
|
|
(define (get key)
|
|
(if (and (pair? collections/pkgs/archives)
|
|
(eq? (caar collections/pkgs/archives) key))
|
|
(cdr (car collections/pkgs/archives))
|
|
'()))
|
|
(let ([pre-archives (get 'archives)]
|
|
[pre-collections (get 'collections)]
|
|
[pre-packages (get 'packages)])
|
|
(cond
|
|
[raco?
|
|
(check-collections short-name rest)
|
|
(values (append pre-collections (map list rest))
|
|
pre-packages
|
|
pre-archives)]
|
|
[else
|
|
(values pre-collections
|
|
pre-packages
|
|
(append pre-archives rest))])))
|
|
(if raco? '("collection") '("archive"))
|
|
(lambda (s)
|
|
(display s)
|
|
(exit 0))))
|
|
|
|
(values short-name x-flags
|
|
x-specific-collections x-specific-packages x-specific-planet-packages
|
|
x-archives))
|
|
|
|
(define (check-collections name collections)
|
|
(for ((v (in-list collections)))
|
|
;; A normal-form collection path matches a symbolic module path;
|
|
;; this is a bit of a hack, but it's not entirely a coincidence:
|
|
(unless (module-path? (string->symbol v))
|
|
(raise-user-error (string->symbol name)
|
|
"bad collection path~a: ~a"
|
|
(cond [(regexp-match? #rx"/$" v)
|
|
" (trailing slash not allowed)"]
|
|
[(regexp-match? #rx"\\\\" v)
|
|
" (backslash not allowed)"]
|
|
[else ""])
|
|
v))))
|
|
|
|
(define (check-packages name packages)
|
|
(for ((v (in-list packages)))
|
|
(define-values (n type) (package-source->name+type v #f))
|
|
(unless (and (eq? type 'name)
|
|
(equal? n v))
|
|
(raise-user-error (string->symbol name)
|
|
"bad package name: ~a"
|
|
v))))
|