suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco setup: add --pkgs argument

Browse Source 
The arguments to `--pkgs` specify collections to set up as the collections
that are (partially) provided by a set of packages.

Closes PR 14396
This commit is contained in:
Matthew Flatt 2014-07-07 06:15:41 +01:00
parent 03413f2298
commit b2897b33d5
6 changed files with 69 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl
View File

@ -115,6 +115,10 @@ flags:
package, in addition to any other specified @|PLaneT| packages or
@nonterm{collection}s.}
@item{@DFlag{pkgs} @nonterm{pkg} @racket[...] --- constrain setup
actions to collections that are within (or partially within) the
named @nonterm{pkg}s.}
@item{@DFlag{tidy} --- remove metadata cache information and
documentation for non-existent collections (to clean up after removal)
even when setup actions are otherwise confined to specified collections.}
@ -249,8 +253,9 @@ collections during an install:
@commandline{env PLT_SETUP_OPTIONS="-j 1" make install}
@history[#:changed "1.2" @elem{Added @DFlag{check-pkg-deps}
and @DFlag{fast-break} flags.}]
@history[#:changed "1.2" @elem{Added the @DFlag{pkgs},
@DFlag{check-pkg-deps}, and
@DFlag{fast-break} flags.}]
@; ------------------------------------------------------------------------

2
racket/collects/setup/option.rkt
View File

@ -6,6 +6,7 @@
set-flag-params
setup-program-name
specific-collections
specific-packages
specific-planet-dirs
archives
archive-implies-reindex
@ -78,6 +79,7 @@
(define-flag-param fail-fast #f)
(define specific-collections (make-parameter null))
(define specific-packages (make-parameter null))
(define specific-planet-dirs (make-parameter null))
(define archives (make-parameter null))

40
racket/collects/setup/setup-cmdline.rkt
View File

@ -6,6 +6,7 @@
(require racket/cmdline
raco/command-name
pkg/name
"private/command-name.rkt")
(provide parse-cmdline)
@ -28,7 +29,7 @@
;; Beware of the poor-man's duplicate of this command-line specification
;; in "main.rkt"!
(define-values (x-specific-collections x-archives)
(define-values (x-specific-collections x-specific-packages x-archives)
(command-line
#:program long-name
#:argv argv
@ -105,6 +106,10 @@
(check-collections short-name collections)
(cons 'collections (map list collections)))
'("Setup specific <collection>s only" "collection")]
[("--pkgs") => (lambda (flag . pkgs)
(check-packages short-name pkgs)
(cons 'packages pkgs))
'("Setup <collection>s in specific <pkg>s only" "pkg")]
[("-A") => (λ (flag . archives)
(cons 'archives archives))
'("Unpack and install <archive>s" "archive")]
@ -114,22 +119,24 @@
(add-flags '((all-users #t)))]
#:handlers
(lambda (collections/archives . rest)
(let ([pre-archives (if (and (pair? collections/archives)
(eq? (caar collections/archives) 'archives))
(cdr (car collections/archives))
'())]
[pre-collections (if (and (pair? collections/archives)
(eq? (caar collections/archives) 'collections))
(cdr (car collections/archives))
'())])
(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)
@ -139,7 +146,9 @@
(printf "If no <archive> or -l <collection> is specified, all collections are setup\n"))
(exit 0))))
(values short-name x-flags x-specific-collections x-specific-planet-packages x-archives))
(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)))
@ -154,3 +163,12 @@
" (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))))

25
racket/collects/setup/setup-core.rkt
View File

@ -33,7 +33,10 @@
"parallel-build.rkt"
"private/cc-struct.rkt"
"link.rkt"
"private/pkg-deps.rkt")
"private/pkg-deps.rkt"
"collection-name.rkt"
(only-in pkg/lib pkg-directory
pkg-single-collection))
(define-namespace-anchor anchor)
@ -193,9 +196,29 @@
(let ([p (collection-file-path "scribble.rkt" "setup")])
(or (file-exists? p)
(file-exists? (get-compilation-bytecode-file p))))))
(define (pkg->collections pkg)
(define dir (pkg-directory pkg))
(cond
[dir
(define collect (pkg-single-collection dir #:name pkg))
(if collect
(list (list collect))
(for/list ([d (directory-list dir)]
#:when (and (directory-exists? (build-path dir d))
(collection-name-element? (path->string d))))
(list d)))]
[else
(error 'pkd->collections
(string-append "package not found\n"
" package: ~a")
pkg)]))
(define x-specific-collections
(append* (specific-collections)
(apply append
(map pkg->collections
(specific-packages)))
(if (and (make-doc-index)
make-docs?)
(append

5
racket/collects/setup/setup-go.rkt
View File

@ -6,7 +6,9 @@
(module test racket/base)
(define-values (short-name x-flags x-specific-collections x-specific-planet-packages x-archives)
(define-values (short-name x-flags
x-specific-collections x-specific-packages x-specific-planet-packages
x-archives)
(parse-cmdline (current-command-line-arguments)))
(define (has-x-flag? s)
@ -23,6 +25,7 @@
[trust-existing-zos (or (has-x-flag? 'trust-existing-zos)
(trust-existing-zos))]
[specific-collections x-specific-collections]
[specific-packages x-specific-packages]
[archives x-archives]
[specific-planet-dirs x-specific-planet-packages]

3
racket/collects/setup/setup.rkt
View File

@ -10,6 +10,7 @@
#:get-target-dir [get-target-dir #f]
#:planet-specs [planet-specs #f]
#:collections [collections #f]
#:pkgs [pkgs #f]
#:make-docs? [make-docs? #t]
#:make-doc-index? [make-doc-index? #f]
#:make-user? [make-user? #t]
@ -31,6 +32,8 @@
[specific-planet-dirs (if planet-specs planet-specs (specific-planet-dirs))]
[specific-collections (if collections collections (specific-collections))]
[specific-packages (if pkgs pkgs (specific-packages))]
[make-only (if (or planet-specs collections) #t (make-only))]