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

raco setup install: add --source' and --binary' modes

Browse Source 
These flags allow a package downloaded in "built" form to be
stripped to source or binary form, which allows a single catalog
to serve three kinds of installations.
This commit is contained in:
Matthew Flatt 2013-07-20 11:54:21 -06:00
parent ddcabcd164
commit c1ca89d674
4 changed files with 74 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl
View File

@ -118,19 +118,25 @@ dependency.}
@defproc[(pkg-stage [desc pkg-desc?] @defproc[(pkg-stage [desc pkg-desc?]
[#:checksum checksum (or/c #f string?) #f] [#:checksum checksum (or/c #f string?) #f]
[#:in-place? in-place? boolean? #f] [#:in-place? in-place? boolean? #f]
[#:namespace namespace namespace? (make-base-namespace)]) [#:namespace namespace namespace? (make-base-namespace)]
[#:strip strip (or/c #f 'source 'binary) #f])
(values string? path? (or/c #f string?) boolean? (listof module-path?))]{ (values string? path? (or/c #f string?) boolean? (listof module-path?))]{
Locates the implementation of the package specified by @racket[desc] Locates the implementation of the package specified by @racket[desc]
and downloads and unpacks it to a temporary directory (as needed). and downloads and unpacks it to a temporary directory (as needed).
If @racket[desc] refers to an existing directory and If @racket[desc] refers to an existing directory and
@racket[in-place?] is true, then the directory is used in place. @racket[in-place?] is true, then the directory is used in place.
The @racket[namespace] argument is passed along to The @racket[namespace] argument is passed along to
@racket[get-info/full] when the package's @filepath{info.rkt} is @racket[get-info/full] when the package's @filepath{info.rkt} is
loaded. loaded.
If @racket[strip] is not @racket[#f], then files and directories are
removed from the prepared directory the same as when creating the
corresponding kind of package. A directory that is staged in-place
cannot be stripped.
The result is the package name, the directory containing the unpacked package content, The result is the package name, the directory containing the unpacked package content,
the checksum (if any) for the unpacked package, whether the the checksum (if any) for the unpacked package, whether the
directory should be removed after the package content is no longer directory should be removed after the package content is no longer
@ -162,7 +168,8 @@ Unless @racket[quiet?] is true, information about the output is repotred to the
#f] #f]
[#:force? force? boolean? #f] [#:force? force? boolean? #f]
[#:ignore-checksums? ignore-checksums? boolean? #f] [#:ignore-checksums? ignore-checksums? boolean? #f]
[#:quiet? boolean? quiet? #f]) [#:quiet? boolean? quiet? #f]
[#:strip strip (or/c #f 'source 'binary) #f])
(or/c 'skip (or/c 'skip
#f #f
(listof (or/c path-string? (listof (or/c path-string?
@ -187,7 +194,8 @@ The package lock must be held; see @racket[with-pkg-lock].}
#f] #f]
[#:all? all? boolean? #f] [#:all? all? boolean? #f]
[#:deps? deps? boolean? #f] [#:deps? deps? boolean? #f]
[#:quiet? boolean? quiet? #f]) [#:quiet? boolean? quiet? #f]
[#:strip strip (or/c #f 'source 'binary) #f])
(or/c 'skip (or/c 'skip
#f #f
(listof (or/c path-string? (listof (or/c path-string?

6
pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl
View File

@ -315,6 +315,10 @@ sub-sub-commands:
of the given directory will not change for each given directory that implements a of the given directory will not change for each given directory that implements a
@tech{multi-collection package}.} @tech{multi-collection package}.}
@item{@DFlag{binary} --- Strips source elements of a package before installing.}
@item{@DFlag{source} --- Strips built elements of a package before installing.}
@item{@DFlag{skip-installed} --- Ignore any @nonterm{pkg-source} @item{@DFlag{skip-installed} --- Ignore any @nonterm{pkg-source}
whose name corresponds to an already-installed package.} whose name corresponds to an already-installed package.}
@ -362,6 +366,8 @@ this command fails without installing any of the @nonterm{pkg}s
@item{@Flag{s} or @DFlag{shared} --- Shorthand for @exec{--scope shared}.} @item{@Flag{s} or @DFlag{shared} --- Shorthand for @exec{--scope shared}.}
@item{@DFlag{scope-dir} @nonterm{dir} --- Selects @nonterm{dir} as the @tech{package scope}, the same as for @command-ref{install}.} @item{@DFlag{scope-dir} @nonterm{dir} --- Selects @nonterm{dir} as the @tech{package scope}, the same as for @command-ref{install}.}
@item{@DFlag{no-setup} --- Same as for @command-ref{install}.} @item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
@item{@DFlag{binary} --- Same as for @command-ref{install}.}
@item{@DFlag{source} --- Same as for @command-ref{install}.}
@item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.} @item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
] ]
} }

63
racket/collects/pkg/lib.rkt
View File

@ -709,6 +709,7 @@
check-sums? check-sums?
download-printf download-printf
metadata-ns metadata-ns
#:strip [strip-mode #f]
#:in-place? [in-place? #f] #:in-place? [in-place? #f]
#:in-place-clean? [in-place-clean? #f]) #:in-place-clean? [in-place-clean? #f])
(define-values (inferred-pkg-name type) (define-values (inferred-pkg-name type)
@ -732,7 +733,8 @@
pkg-name pkg-name
#:given-checksum given-checksum #:given-checksum given-checksum
check-sums? download-printf check-sums? download-printf
metadata-ns)] metadata-ns
#:strip strip-mode)]
[(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github)) [(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github))
(define pkg-url (string->url pkg)) (define pkg-url (string->url pkg))
(define scheme (url-scheme pkg-url)) (define scheme (url-scheme pkg-url))
@ -791,9 +793,11 @@
check-sums? check-sums?
download-printf download-printf
metadata-ns metadata-ns
#:in-place? #t #:strip strip-mode
#:in-place? (not strip-mode)
#:in-place-clean? #t) #:in-place-clean? #t)
(set! staged? #t))) (unless strip-mode
(set! staged? #t))))
(λ () (λ ()
(unless staged? (unless staged?
(delete-directory/files tmp-dir))))) (delete-directory/files tmp-dir)))))
@ -869,7 +873,8 @@
#:given-checksum checksum #:given-checksum checksum
check-sums? check-sums?
download-printf download-printf
metadata-ns)) metadata-ns
#:strip strip-mode))
(λ () (λ ()
(when (or (file-exists? package-path) (when (or (file-exists? package-path)
(directory-exists? package-path)) (directory-exists? package-path))
@ -953,11 +958,13 @@
check-sums? check-sums?
download-printf download-printf
metadata-ns metadata-ns
#:in-place? #t #:strip strip-mode
#:in-place? (not strip-mode)
#:in-place-clean? #t) #:in-place-clean? #t)
`(file ,(simple-form-path* pkg))) `(file ,(simple-form-path* pkg)))
checksum) checksum)
(set! staged? #t))) (unless strip-mode
(set! staged? #t))))
(λ () (λ ()
(unless staged? (unless staged?
(delete-directory/files pkg-dir))))] (delete-directory/files pkg-dir))))]
@ -981,11 +988,18 @@
[else [else
(define pkg-dir (define pkg-dir
(if in-place? (if in-place?
pkg (if strip-mode
(pkg-error "cannot strip directory in place")
pkg)
(let ([pkg-dir (make-temporary-file "pkg~a" 'directory)]) (let ([pkg-dir (make-temporary-file "pkg~a" 'directory)])
(delete-directory pkg-dir) (delete-directory pkg-dir)
(make-parent-directory* pkg-dir) (if strip-mode
(copy-directory/files pkg pkg-dir #:keep-modify-seconds? #t) (begin
(make-directory* pkg-dir)
(generate-stripped-directory strip-mode pkg pkg-dir))
(begin
(make-parent-directory* pkg-dir)
(copy-directory/files pkg pkg-dir #:keep-modify-seconds? #t)))
pkg-dir))) pkg-dir)))
(install-info pkg-name (install-info pkg-name
`(dir ,(simple-form-path* pkg)) `(dir ,(simple-form-path* pkg))
@ -1003,7 +1017,8 @@
#:given-checksum checksum #:given-checksum checksum
check-sums? check-sums?
download-printf download-printf
metadata-ns)) metadata-ns
#:strip strip-mode))
(when (and (install-info-checksum info) (when (and (install-info-checksum info)
check-sums? check-sums?
(not (equal? (install-info-checksum info) checksum))) (not (equal? (install-info-checksum info) checksum)))
@ -1019,7 +1034,8 @@
(define (pkg-stage desc (define (pkg-stage desc
#:namespace [metadata-ns (make-metadata-namespace)] #:namespace [metadata-ns (make-metadata-namespace)]
#:checksum [checksum #f] #:checksum [checksum #f]
#:in-place? [in-place? #f]) #:in-place? [in-place? #f]
#:strip [strip-mode #f])
(define i (stage-package/info (pkg-desc-source desc) (define i (stage-package/info (pkg-desc-source desc)
(pkg-desc-type desc) (pkg-desc-type desc)
(pkg-desc-name desc) (pkg-desc-name desc)
@ -1027,7 +1043,8 @@
#t #t
void void
metadata-ns metadata-ns
#:in-place? in-place?)) #:in-place? in-place?
#:strip strip-mode))
(values (install-info-name i) (values (install-info-name i)
(install-info-directory i) (install-info-directory i)
(install-info-checksum i) (install-info-checksum i)
@ -1064,6 +1081,7 @@
#:quiet? [quiet? #f] #:quiet? [quiet? #f]
#:install-conversation [install-conversation #f] #:install-conversation [install-conversation #f]
#:update-conversation [update-conversation #f] #:update-conversation [update-conversation #f]
#:strip [strip-mode #f]
descs) descs)
(define download-printf (if quiet? void printf/flush)) (define download-printf (if quiet? void printf/flush))
(define check-sums? (not ignore-checksums?)) (define check-sums? (not ignore-checksums?))
@ -1321,7 +1339,8 @@
(for/list ([v (in-list descs)]) (for/list ([v (in-list descs)])
(stage-package/info (pkg-desc-source v) (pkg-desc-type v) (pkg-desc-name v) (stage-package/info (pkg-desc-source v) (pkg-desc-type v) (pkg-desc-name v)
check-sums? download-printf check-sums? download-printf
metadata-ns))) metadata-ns
#:strip strip-mode)))
;; For the top-level call, we need to double-check that all provided packages ;; For the top-level call, we need to double-check that all provided packages
;; were distinct: ;; were distinct:
(for/fold ([ht (hash)]) ([i (in-list infos)] (for/fold ([ht (hash)]) ([i (in-list infos)]
@ -1444,7 +1463,8 @@
#:updating? [updating? #f] #:updating? [updating? #f]
#:quiet? [quiet? #f] #:quiet? [quiet? #f]
#:install-conversation [install-conversation #f] #:install-conversation [install-conversation #f]
#:update-conversation [update-conversation #f]) #:update-conversation [update-conversation #f]
#:strip [strip-mode #f])
(define new-descs (define new-descs
(remove-duplicates (remove-duplicates
(if (not skip-installed?) (if (not skip-installed?)
@ -1473,6 +1493,7 @@
#:updating? updating? #:updating? updating?
#:install-conversation inst-conv #:install-conversation inst-conv
#:update-conversation updt-conv #:update-conversation updt-conv
#:strip strip-mode
(for/list ([dep (in-list deps)]) (for/list ([dep (in-list deps)])
(pkg-desc dep #f #f #t)))])]) (pkg-desc dep #f #f #t)))])])
(install-packages (install-packages
@ -1487,6 +1508,7 @@
#:quiet? quiet? #:quiet? quiet?
#:install-conversation install-conversation #:install-conversation install-conversation
#:update-conversation update-conversation #:update-conversation update-conversation
#:strip strip-mode
new-descs))) new-descs)))
(define ((update-is-possible? db) pkg-name) (define ((update-is-possible? db) pkg-name)
@ -1533,7 +1555,8 @@
#:all? [all? #f] #:all? [all? #f]
#:dep-behavior [dep-behavior #f] #:dep-behavior [dep-behavior #f]
#:deps? [deps? #f] #:deps? [deps? #f]
#:quiet? [quiet? #f]) #:quiet? [quiet? #f]
#:strip [strip-mode #f])
(define download-printf (if quiet? void printf)) (define download-printf (if quiet? void printf))
(define metadata-ns (make-metadata-namespace)) (define metadata-ns (make-metadata-namespace))
(define db (read-pkg-db)) (define db (read-pkg-db))
@ -1564,6 +1587,7 @@
#:pre-succeed (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update)) #:pre-succeed (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update))
#:dep-behavior dep-behavior #:dep-behavior dep-behavior
#:quiet? quiet? #:quiet? quiet?
#:strip strip-mode
to-update)])) to-update)]))
(define (pkg-show indent #:directory? [dir? #f]) (define (pkg-show indent #:directory? [dir? #f])
@ -2269,7 +2293,8 @@
(#:dep-behavior dep-behavior/c (#:dep-behavior dep-behavior/c
#:all? boolean? #:all? boolean?
#:deps? boolean? #:deps? boolean?
#:quiet? boolean?) #:quiet? boolean?
#:strip (or/c #f 'source 'binary))
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))] (or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
[pkg-remove [pkg-remove
(->* ((listof string?)) (->* ((listof string?))
@ -2287,7 +2312,8 @@
#:force? boolean? #:force? boolean?
#:ignore-checksums? boolean? #:ignore-checksums? boolean?
#:skip-installed? boolean? #:skip-installed? boolean?
#:quiet? boolean?) #:quiet? boolean?
#:strip (or/c #f 'source 'binary))
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))] (or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
[pkg-catalog-show [pkg-catalog-show
(->* ((listof string?)) (->* ((listof string?))
@ -2315,7 +2341,8 @@
[pkg-stage (->* (pkg-desc?) [pkg-stage (->* (pkg-desc?)
(#:namespace namespace? (#:namespace namespace?
#:checksum (or/c #f string?) #:checksum (or/c #f string?)
#:in-place? boolean?) #:in-place? boolean?
#:strip (or/c #f 'source 'binary))
(values string? (values string?
path? path?
(or/c #f string?) (or/c #f string?)

15
racket/collects/pkg/main.rkt
View File

@ -78,6 +78,8 @@
#:once-any #:once-any
[#:bool link () ("Link a directory package source in place")] [#:bool link () ("Link a directory package source in place")]
[#:bool static-link () ("Link in place, promising collections do not change")] [#:bool static-link () ("Link in place, promising collections do not change")]
[#:bool source () ("Strip built elements of the package before installing")]
[#:bool binary () ("Strip source elements of the package before installing")]
#:once-each #:once-each
[#:bool skip-installed () ("Skip a <pkg-source> if already installed")] [#:bool skip-installed () ("Skip a <pkg-source> if already installed")]
#:once-any #:once-any
@ -92,7 +94,7 @@
[(#:str dir #f) scope-dir () "Install for package scope <dir>"] [(#:str dir #f) scope-dir () "Install for package scope <dir>"]
#:once-each #:once-each
[(#:str catalog #f) catalog () "Use <catalog> instead of configured catalogs"] [(#:str catalog #f) catalog () "Use <catalog> instead of configured catalogs"]
[#:bool no-setup () ("Don't run `raco setup' after changing packages (generally" [#:bool no-setup () ("Don't run `raco setup' after changing packages (usually"
"not a good idea)")] "not a good idea)")]
[(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"] [(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"]
#:args pkg-source #:args pkg-source
@ -110,6 +112,7 @@
#:force? force #:force? force
#:ignore-checksums? ignore-checksums #:ignore-checksums? ignore-checksums
#:skip-installed? skip-installed #:skip-installed? skip-installed
#:strip (or (and source 'source) (and binary 'binary))
(for/list ([p (in-list pkg-source)]) (for/list ([p (in-list pkg-source)])
(define a-type (or (and link 'link) (define a-type (or (and link 'link)
(and static-link 'static-link) (and static-link 'static-link)
@ -141,8 +144,11 @@
[#:bool user ("-u") "Shorthand for `--scope user'"] [#:bool user ("-u") "Shorthand for `--scope user'"]
[#:bool shared ("-s") "Shorthand for `--scope shared'"] [#:bool shared ("-s") "Shorthand for `--scope shared'"]
[(#:str dir #f) scope-dir () "Update for package scope <dir>"] [(#:str dir #f) scope-dir () "Update for package scope <dir>"]
#:once-any
[#:bool source () ("Strip built elements of the package before installing")]
[#:bool binary () ("Strip source elements of the package before installing")]
#:once-each #:once-each
[#:bool no-setup () ("Don't run `raco setup' after changing packages (generally" [#:bool no-setup () ("Don't run `raco setup' after changing packages (usually"
"not a good idea)")] "not a good idea)")]
[(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"] [(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"]
#:args pkg #:args pkg
@ -155,7 +161,8 @@
(pkg-update pkg (pkg-update pkg
#:all? all #:all? all
#:dep-behavior deps #:dep-behavior deps
#:deps? update-deps))) #:deps? update-deps
#:strip (or (and source 'source) (and binary 'binary)))))
(setup no-setup setup-collects jobs)))] (setup no-setup setup-collects jobs)))]
[remove [remove
"Remove packages" "Remove packages"
@ -173,7 +180,7 @@
[#:bool shared ("-s") "Shorthand for `--scope shared'"] [#:bool shared ("-s") "Shorthand for `--scope shared'"]
[(#:str dir #f) scope-dir () "Remove for package scope <dir>"] [(#:str dir #f) scope-dir () "Remove for package scope <dir>"]
#:once-each #:once-each
[#:bool no-setup () ("Don't run `raco setup' after changing packages (generally" [#:bool no-setup () ("Don't run `raco setup' after changing packages (usually"
"not a good idea)")] "not a good idea)")]
[(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"] [(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"]
#:args pkg #:args pkg