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

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

@ -118,7 +118,8 @@ dependency.}
@defproc[(pkg-stage [desc pkg-desc?]
[#:checksum checksum (or/c #f string?) #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?))]{
Locates the implementation of the package specified by @racket[desc]
@ -131,6 +132,11 @@ The @racket[namespace] argument is passed along to
@racket[get-info/full] when the package's @filepath{info.rkt} is
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 checksum (if any) for the unpacked package, whether the
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]
[#:force? force? 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
#f
(listof (or/c path-string?
@ -187,7 +194,8 @@ The package lock must be held; see @racket[with-pkg-lock].}
#f]
[#:all? all? 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
#f
(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
@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}
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{@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{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}.}
]
}

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

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

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

@ -78,6 +78,8 @@
#:once-any
[#:bool link () ("Link a directory package source in place")]
[#: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
[#:bool skip-installed () ("Skip a <pkg-source> if already installed")]
#:once-any
@ -92,7 +94,7 @@
[(#:str dir #f) scope-dir () "Install for package scope <dir>"]
#:once-each
[(#: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)")]
[(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"]
#:args pkg-source
@ -110,6 +112,7 @@
#:force? force
#:ignore-checksums? ignore-checksums
#:skip-installed? skip-installed
#:strip (or (and source 'source) (and binary 'binary))
(for/list ([p (in-list pkg-source)])
(define a-type (or (and link 'link)
(and static-link 'static-link)
@ -141,8 +144,11 @@
[#:bool user ("-u") "Shorthand for `--scope user'"]
[#:bool shared ("-s") "Shorthand for `--scope shared'"]
[(#: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
[#: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)")]
[(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"]
#:args pkg
@ -155,7 +161,8 @@
(pkg-update pkg
#:all? all
#:dep-behavior deps
#:deps? update-deps)))
#:deps? update-deps
#:strip (or (and source 'source) (and binary 'binary)))))
(setup no-setup setup-collects jobs)))]
[remove
"Remove packages"
@ -173,7 +180,7 @@
[#:bool shared ("-s") "Shorthand for `--scope shared'"]
[(#:str dir #f) scope-dir () "Remove for package scope <dir>"]
#: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)")]
[(#:num n #f) jobs ("-j") "Setup with <n> parallel jobs"]
#:args pkg