raco pkg: support single-collection packages

A package directory is in single-collection mode when it has an
"info.rkt" file containing a `single-collection' definition.
The string value of `single-collection' provides the collection's
name.
This commit is contained in:
Matthew Flatt 2013-06-04 18:55:42 -06:00
parent 6e8c9ed15a
commit 7953edc79c
12 changed files with 237 additions and 54 deletions

View File

@ -88,7 +88,7 @@
(if (and (list? mod)
(= 2 (length mod))
(eq? (car mod) 'lib)
(regexp-match #rx"[.]rkt$" (cadr mod)))
(regexp-match? #rx"[.]rkt$" (cadr mod)))
(string->symbol (regexp-replace #rx"[.]rkt$" (cadr mod) ""))
mod))
@ -143,7 +143,7 @@
(with-handlers ([exn:fail? (λ (x)
(log-exn x "getting info")
#f)])
(get-info/full pkg-dir #:namespace metadata-ns)))
(get-info/full pkg-dir #:namespace metadata-ns)))
(define v
(if get-info
(get-info key get-default)
@ -410,6 +410,7 @@
(for/hash ([(k v) (in-hash the-db)])
(values k
(if (eq? 'pnr (car (pkg-info-orig-pkg v)))
;; note: legacy 'pnr entry cannot be a single-collection package
(struct-copy pkg-info v
[orig-pkg `(catalog ,(cadr (pkg-info-orig-pkg v)))])
v))))))
@ -499,6 +500,7 @@
(hash-ref cfg "default-scope" "user"))))
(struct pkg-info (orig-pkg checksum auto?) #:prefab)
(struct sc-pkg-info pkg-info (collect) #:prefab) ; a pkg with a single collection
(struct install-info (name orig-pkg directory clean? checksum module-paths))
(define (update-install-info-orig-pkg if op)
@ -558,8 +560,8 @@
(define ((remove-package quiet?) pkg-name)
(unless quiet?
(printf "Removing ~a\n" pkg-name))
(match-define (pkg-info orig-pkg checksum _)
(package-info pkg-name))
(define pi (package-info pkg-name))
(match-define (pkg-info orig-pkg checksum _) pi)
(define pkg-dir (pkg-directory* pkg-name))
(remove-from-pkg-db! pkg-name)
(match orig-pkg
@ -568,13 +570,13 @@
#:remove? #t
#:user? (not (eq? (current-pkg-scope) 'installation))
#:version-regexp (link-version-regexp)
#:root? #t)]
#:root? (not (sc-pkg-info? pi)))]
[_
(links pkg-dir
#:remove? #t
#:user? (not (eq? (current-pkg-scope) 'installation))
#:version-regexp (link-version-regexp)
#:root? #t)
#:root? (not (sc-pkg-info? pi)))
(delete-directory/files pkg-dir)]))
(define (pkg-remove in-pkgs
@ -643,7 +645,8 @@
given-pkg-name
#:given-checksum [given-checksum #f]
check-sums?
download-printf)
download-printf
metadata-ns)
(define-values (inferred-pkg-name type)
(if (path? pkg)
(package-source->name+type (path->string pkg)
@ -664,7 +667,8 @@
(stage-package/info (string-append "github://github.com/" pkg) type
pkg-name
#:given-checksum given-checksum
check-sums? download-printf)]
check-sums? download-printf
metadata-ns)]
[(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github))
(define pkg-url (string->url pkg))
(define scheme (url-scheme pkg-url))
@ -719,7 +723,8 @@
pkg-name
#:given-checksum checksum
check-sums?
download-printf))
download-printf
metadata-ns))
(λ ()
(delete-directory/files tmp-dir))))
(λ ()
@ -792,7 +797,8 @@
pkg-name
#:given-checksum checksum
check-sums?
download-printf))
download-printf
metadata-ns))
(λ ()
(when (or (file-exists? package-path)
(directory-exists? package-path))
@ -872,7 +878,8 @@
pkg-name
#:given-checksum checksum
check-sums?
download-printf)
download-printf
metadata-ns)
`(file ,(simple-form-path* pkg)))
checksum))
(λ ()
@ -888,7 +895,7 @@
`(link ,(simple-form-path* pkg))
pkg
#f #f
(directory->module-paths pkg))]
(directory->module-paths pkg pkg-name metadata-ns))]
[else
(define pkg-dir
(make-temporary-file "pkg~a" 'directory))
@ -899,7 +906,7 @@
`(dir ,(simple-form-path* pkg))
pkg-dir
#t #f
(directory->module-paths pkg-dir))]))]
(directory->module-paths pkg-dir pkg-name metadata-ns))]))]
[(eq? type 'name)
(define catalog-info (package-catalog-lookup pkg #f))
(define source (hash-ref catalog-info 'source))
@ -909,7 +916,8 @@
pkg-name
#:given-checksum checksum
check-sums?
download-printf))
download-printf
metadata-ns))
(when (and (install-info-checksum info)
check-sums?
(not (equal? (install-info-checksum info) checksum)))
@ -929,8 +937,10 @@
(pkg-desc-name desc)
#:given-checksum checksum
#t
void))
(values (install-info-directory i)
void
(make-metadata-namespace)))
(values (install-info-name i)
(install-info-directory i)
(install-info-checksum i)
(install-info-clean? i)))
@ -1034,7 +1044,7 @@
[(and
(not (eq? dep-behavior 'force))
(let ()
(define deps (get-all-deps metadata-ns pkg-dir ))
(define deps (get-all-deps metadata-ns pkg-dir))
(define unsatisfied-deps
(map dependency->source
(filter-not (λ (dep)
@ -1198,20 +1208,28 @@
final-pkg-dir]
[else
pkg-dir]))
(log-pkg-debug "creating link to ~e" final-pkg-dir)
(define single-collect (pkg-single-collection final-pkg-dir
#:namespace metadata-ns))
(log-pkg-debug "creating ~alink to ~e"
(if single-collect "single-collection " "")
final-pkg-dir)
(links final-pkg-dir
#:name single-collect
#:user? (not (eq? 'installation (current-pkg-scope)))
#:version-regexp (link-version-regexp)
#:root? #t)
#:root? (not single-collect))
(define this-pkg-info
(pkg-info orig-pkg checksum auto?))
(if single-collect
(sc-pkg-info orig-pkg checksum auto? single-collect)
(pkg-info orig-pkg checksum auto?)))
(log-pkg-debug "updating db with ~e to ~e" pkg-name this-pkg-info)
(update-pkg-db! pkg-name this-pkg-info))]))
(define metadata-ns (make-metadata-namespace))
(define infos
(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)))
check-sums? download-printf
metadata-ns)))
(define setup-collects (get-setup-collects (map install-info-directory
(append old-infos infos))
metadata-ns))
@ -1223,6 +1241,12 @@
(for-each (λ (t) (t)) do-its)
setup-collects)
(define (pkg-single-collection dir #:namespace [metadata-ns (make-metadata-namespace)])
(define i (get-info/full dir #:namespace metadata-ns))
(and i (let ([s (i 'single-collection (lambda () #f))])
(and (string? s)
s))))
(define (get-setup-collects pkg-directories metadata-ns)
(maybe-append
(for/list ([pkg-dir (in-list pkg-directories)])
@ -1478,6 +1502,10 @@
(apply zip pkg/complete (directory-list))))]
['plt
(define dest pkg/complete)
(when (pkg-single-collection dir)
(pkg-error (~a "single-collection package not supported in .plt format\n"
" directory: ~a")
dir))
(parameterize ([current-directory dir])
(define names (filter std-filter (directory-list)))
(define dirs (filter directory-exists? names))
@ -1841,13 +1869,14 @@
(define (get-pkg-content desc
#:extract-info [extract-info extract-dependencies])
(define-values (dir cksum clean?) (pkg-stage desc))
(define-values (pkg-name dir cksum clean?) (pkg-stage desc))
(define metadata-ns (make-metadata-namespace))
(define get-info (with-handlers ([exn:fail? (λ (x)
(log-exn x "getting info")
#f)])
(get-info/full dir #:namespace (make-base-namespace))))
(get-info/full dir #:namespace metadata-ns)))
(define module-paths
(set->list (directory->module-paths dir)))
(set->list (directory->module-paths dir pkg-name metadata-ns)))
(begin0
(values cksum
module-paths
@ -1855,15 +1884,21 @@
(when clean?
(delete-directory/files dir))))
(define (directory->module-paths dir)
(define (directory->module-paths dir pkg-name metadata-ns)
(define dummy (build-path dir "dummy.rkt"))
(define compiled (string->path-element "compiled"))
(define single-collect (pkg-single-collection dir #:namespace metadata-ns))
(define (try-path s f)
(define mp
`(lib ,(apply ~a
#:separator "/"
(map path-element->string
(explode-path f)))))
#:separator "/"
(let ([l (map path-element->string
(explode-path f))])
(if single-collect
(if (eq? 'relative (car l))
(cons single-collect (cdr l))
(cons single-collect l))
l)))))
(if (module-path? mp)
(set-add s (collapse-module-path mp dummy))
s))
@ -1874,7 +1909,7 @@
[else
(define-values (base name dir?) (split-path f))
(cond
[(eq? 'relative base) s]
[(and (eq? 'relative base) (not single-collect)) s]
[else
(define bstr (path-element->bytes name))
(cond
@ -1984,7 +2019,8 @@
with-pkg-lock
with-pkg-lock/read-only
(struct-out pkg-info)
pkg-desc?
(struct-out sc-pkg-info)
pkg-desc?
(contract-out
[current-pkg-scope
(parameter/c package-scope/c)]
@ -2064,7 +2100,8 @@
(hash/c string? pkg-info?))]
[pkg-stage (->* (pkg-desc?)
(#:checksum (or/c #f string?))
(values path?
(values string?
path?
(or/c #f string?)
boolean?))]
[pkg-config-catalogs
@ -2093,4 +2130,8 @@
any/c))
(values (or/c #f string?)
(listof module-path?)
any/c))]))
any/c))]
[pkg-single-collection
(->* (path-string?)
(#:namespace namespace?)
(or/c #f string?))]))

View File

@ -126,12 +126,12 @@ dependency.}
@defproc[(pkg-stage [desc pkg-desc?]
[#:checksum checksum (or/c #f string?) #f])
(values path? (or/c #f string?) boolean?)]{
(values string? path? (or/c #f string?) boolean?)]{
Locates the implementation of the package specified by @racket[desc] and
downloads and unpacks it to a temporary directory (as needed).
The result is 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, and whether the
directory should be removed after the package content is no longer
needed.}
@ -290,6 +290,19 @@ name} has no resolution. Details for the package are provided in the
same form as from @racket[get-all-pkg-details-from-catalogs].}
@defproc[(pkg-single-collection [dir path-string?]
[#:namespace ns namespace? (make-base-namespapce)])
(or/c #f string?)]{
Returns @racket[#f] if @racket[dir] represents a @tech{multi-collection package},
and returns a string for the collection contained by the package if @racket[dir]
represents a @tech{single-collection package}.
Detecting a @tech{single-collection package} may involve loading an
@filepath{info.rkt} file via @racket[getinfo/full], in which case
@racket[namespace] is used.}
@defproc[(get-pkg-content [desc pkg-desc?]
[#:extract-info
extract-proc

View File

@ -83,9 +83,19 @@ name as the package. The @tech{checksum} is typically left implicit.
The package directory can contain a file named @filepath{info.rkt}
to declare other metadata (see @secref["metadata"]).
A @deftech{package source} identifies a @tech{package}
A @tech{package} is a @deftech{multi-collection package} by default;
each directory within the package is a @gtech{collection} that is
provided by the package. If a @tech{package} has an
@filepath{info.rkt} file that defines @racketidfont{single-collection}
as a string, then the package is a @deftech{single-collection
package}; in that case, the package directory doubles as
@gtech{collection} named by @racketidfont{single-collection}.
More generally, a @deftech{package source} identifies a @tech{package}
representation. Each package source type has a different way of
storing the @tech{checksum}. The valid package source types are:
storing the @tech{checksum} and providing the package content (usually
with @tech{multi-collection package} and @tech{single-collection
package} variants). The valid @tech{package source} types are:
@itemlist[
@ -96,7 +106,10 @@ example, @filepath{~/tic-tac-toe.zip}'s @tech{checksum} would be inside
@filepath{~/tic-tac-toe.zip.CHECKSUM}. The valid archive formats
are (currently) @filepath{.zip}, @filepath{.tar}, @filepath{.tgz},
@filepath{.tar.gz}, and
@filepath{.plt}.
@filepath{.plt}, each of which represents package content analogous
to a directory ,
but the @filepath{.plt} format does not accommodate a
@tech{single-collection package} representation.
A package source is inferred to refer to a file
only when it has a suffix matching a valid archive format
@ -213,7 +226,9 @@ into account when determining a @tech{package update}, although a change
in a package's @tech{version} (in either direction)
implies a change in the @tech{checksum} because the checksum is
computed from the package source and the meta-data that specifies
the version is part of the source.
the version is part of the source. A @tech{single-collection package}
can be a @tech{package update} of a @tech{multi-collection package}
and vice versa.
A @deftech{package scope} determines the effect of package installations,
updates, @|etc|, with respect to different users, Racket versions, and
@ -274,7 +289,11 @@ sub-sub-commands:
environment variable @envvar{PLT_PKG_NOSETUP} is set to any non-empty value.}
@item{@DFlag{link} --- Implies @exec{--type dir} (and overrides any specified type),
and links the existing directory as an installed package.}
and links the existing directory as an installed package. The package is identified
as a @tech{single-collection package} or a @tech{multi-collection package} at the
time that it is installed, and that categorization does not change even if the @schemeidfont{single-collection}
definition in @filepath{info.rkt} is changed (i.e., he package must be removed and re-installed
for the change to take effect).}
@item{@DFlag{scope} @nonterm{scope} --- Selects the @tech{package scope} for installation, where @nonterm{scope} is one of
@itemlist[
@ -496,26 +515,38 @@ select its name, @nonterm{package}:
@commandline{mkdir @nonterm{package}}
Next, link your development directory to your local package
repository:
@commandline{raco pkg install --link @nonterm{package}}
Optionally, enter your directory and create a basic @filepath{info.rkt} file:
@commandline{cd @nonterm{package}}
@commandline{echo "#lang setup/infotab" > info.rkt}
@commandline{echo "(define deps (list))" >> info.rkt}
The @filepath{info.rkt} file is not necessary if you have no dependencies, but
you may wish to create it to simplify adding dependencies in the
future. (Note that this @filepath{info.rkt} is for the package, not for
a collection; definitions such as @racket[scribblings] or
@racket[raco-commands] work only in a collection's @filepath{info.rkt}.)
The @filepath{info.rkt} file is not necessary for a
@tech{multi-collection package} with no dependencies, but you may wish
to create it to simplify adding dependencies in the future. For a
@tech{single-collection package}, you must create an
@filepath{info.rkt} file, and you must give the collection a name,
@nonterm{collect}:
Next, inside the @nonterm{package} directory, create directories for
the collections and modules that your package will provide. For
example, the developer of @pkgname{tic-tac-toe} package that provides
@commandline{echo '(define single-collection "@nonterm{collect}")' >> info.rkt}
Note that in the case of a @tech{multi-collection package}, the
@filepath{info.rkt} is for the package, not for a collection;
definitions such as @racket[scribblings] or @racket[raco-commands]
work only in a collection's @filepath{info.rkt}. For a
@tech{single-collection package}, the @filepath{info.rkt} file serves
double-duty for the package and collection.
Next, link your development directory to your local package
repository:
@commandline{raco pkg install --link @nonterm{package}}
Finally, inside the @nonterm{package} directory, add directories and/or
files to implement the collections and/or modules that your package
provide. For
example, the developer of a @pkgname{tic-tac-toe} @tech{multi-collection package} that provides
@racketidfont{games/tic-tac-toe/main} and @racketidfont{data/matrix}
libraries might create directories and files like this:
@ -740,7 +771,7 @@ The following @filepath{info.rkt} fields are used by the package manager:
set up via @exec{raco setup} after the package is installed, or
@racket['all] to indicate that all collections need to be
setup. By default, only collections included in the package are
set up (plus collections for global documentation catalogs and
set up (plus collections for global documentation indexes and
links).}
]

View File

@ -0,0 +1,3 @@
#lang setup/infotab
(define deps (list "pkg-test1"))

View File

@ -0,0 +1,4 @@
#lang racket/base
(printf "pkg-test3/main version 2 loaded\n")
(exit 0)

View File

@ -0,0 +1,4 @@
#lang setup/infotab
(define single-collection "pkg-test3")
(define deps (list "pkg-test1"))

View File

@ -0,0 +1,4 @@
#lang racket/base
(printf "pkg-test3/main loaded\n")
(exit 0)

View File

@ -46,6 +46,15 @@
$ "test -f test-pkgs/pkg-test1b.zip"
$ "raco pkg install test-pkgs/pkg-test1b.zip" =exit> 1)
(shelly-install* "conflicts are caught in single-collection"
"test-pkgs/pkg-test1.zip test-pkgs/pkg-test3.zip" "pkg-test1 pkg-test3"
$ "test -f test-pkgs/pkg-test3-v2.zip"
$ "raco pkg install test-pkgs/pkg-test3-v2.zip" =exit> 1)
(shelly-install* "conflicts are caught in single-collection against multi-collection"
"test-pkgs/pkg-test1.zip test-pkgs/pkg-test3-v2.zip" "pkg-test1 pkg-test3-v2"
$ "test -f test-pkgs/pkg-test3.zip"
$ "raco pkg install test-pkgs/pkg-test3.zip" =exit> 1)
(shelly-wind
$ "cp -r test-pkgs/pkg-test1 test-pkgs/pkg-test1-linking"
(shelly-install* "conflicts are caught, even with a link"

View File

@ -42,6 +42,8 @@
(shelly-create "pkg-test1-conflict" "zip")
(shelly-create "pkg-test1" "plt")
(shelly-create "racket-conflict" "tgz")
(shelly-create "pkg-test3" "zip")
(shelly-create "pkg-test3-v2" "zip")
$ "raco pkg create --format txt test-pkgs/pkg-test1" =exit> 1

View File

@ -33,6 +33,17 @@
$ "raco pkg remove pkg-test2"
$ "racket -e '(require pkg-test2)'" =exit> 1))
$ "test -f test-pkgs/pkg-test3.zip"
(with-fake-root
(shelly-case
"local - fail (default, single-collection)"
$ "racket -e '(require pkg-test3)'" =exit> 1
$ "raco pkg install test-pkgs/pkg-test3.zip" =exit> 1
$ "raco pkg install test-pkgs/pkg-test1.zip" =exit> 0
$ "raco pkg install test-pkgs/pkg-test3.zip" =exit> 0
$ "racket -e '(require pkg-test3)'" =exit> 0
$ "raco pkg remove pkg-test3"))
(with-fake-root
(shelly-case
"local - looks at all packages given on cmdline"
@ -100,6 +111,14 @@
$ "raco pkg remove pkg-test2"
$ "racket -e '(require pkg-test2)'" =exit> 1))
(with-fake-root
(shelly-case
"local - search-auto, single-collection"
$ "raco pkg config --set catalogs http://localhost:9990"
$ "racket -e '(require pkg-test3)'" =exit> 1
$ "raco pkg install --deps search-auto test-pkgs/pkg-test3.zip" =exit> 0
$ "racket -e '(require pkg-test3)'" =exit> 0))
(with-fake-root
(shelly-case
"remote - search-ask (default) [y]"

View File

@ -23,6 +23,9 @@
(shelly-install "local package (zip)" "test-pkgs/pkg-test1.zip")
(shelly-install "local package (plt)" "test-pkgs/pkg-test1.plt")
(shelly-install* "local package (zip, compiled)" "test-pkgs/pkg-test1b.zip" "pkg-test1b")
(shelly-install* "local package (zip, single-collection)"
"test-pkgs/pkg-test1.zip test-pkgs/pkg-test3.zip"
"pkg-test1 pkg-test3")
(shelly-case
"invalid package format is an error"
@ -73,7 +76,12 @@
"local directory fails when not there"
$ "raco pkg install test-pkgs/pkg-test1-not-there/" =exit> 1)
(shelly-install "local package (directory)" "test-pkgs/pkg-test1/")
(shelly-install "local package (directory)" "test-pkgs/pkg-test1/"
$ "racket -e '(require pkg-test1)'")
(shelly-install* "local package (single-collection directory)"
"test-pkgs/pkg-test1/ test-pkgs/pkg-test3/"
"pkg-test1 pkg-test3"
$ "racket -e '(require pkg-test3)'")
(with-fake-root
(shelly-case
@ -96,6 +104,19 @@
(finally
$ "rm -r test-pkgs/pkg-test1-linking"))))
(with-fake-root
(shelly-case
"linking local directory, single-collection"
(shelly-wind
$ "cp -r test-pkgs/pkg-test3 test-pkgs/pkg-test3-linking"
$ "racket -e '(require pkg-test3)'" =exit> 1
$ "raco pkg install --link test-pkgs/pkg-test1 test-pkgs/pkg-test3-linking"
$ "racket -e '(require pkg-test3)'"
$ "raco pkg remove pkg-test1 pkg-test3-linking"
$ "racket -e '(require pkg-test3)'" =exit> 1
(finally
$ "rm -r test-pkgs/pkg-test3-linking"))))
(with-fake-root
(shelly-case
"remote/name package, doesn't work when no package there"

View File

@ -42,6 +42,38 @@
$ "rm -f test-pkgs/update-test/pkg-test1.zip"
$ "rm -f test-pkgs/update-test/pkg-test1.zip.CHECKSUM"))
(shelly-wind
$ "mkdir -p test-pkgs/update-test"
$ "cp -f test-pkgs/pkg-test3.zip test-pkgs/update-test/pkg-test3.zip"
$ "cp -f test-pkgs/pkg-test3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
(shelly-install* "remote packages can be updated, single-colelction to multi-collection"
"test-pkgs/pkg-test1.zip http://localhost:9999/update-test/pkg-test3.zip"
"pkg-test1 pkg-test3"
$ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n"
$ "cp -f test-pkgs/pkg-test3-v2.zip test-pkgs/update-test/pkg-test3.zip"
$ "cp -f test-pkgs/pkg-test3-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
$ "raco pkg update pkg-test3" =exit> 0
$ "racket -e '(require pkg-test3)'" =stdout> "pkg-test3/main version 2 loaded\n")
(finally
$ "rm -f test-pkgs/update-test/pkg-test3.zip"
$ "rm -f test-pkgs/update-test/pkg-test3.zip.CHECKSUM"))
(shelly-wind
$ "mkdir -p test-pkgs/update-test"
$ "cp -f test-pkgs/pkg-test3-v2.zip test-pkgs/update-test/pkg-test3.zip"
$ "cp -f test-pkgs/pkg-test3-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
(shelly-install* "remote packages can be updated, multi-colelction to single-collection"
"test-pkgs/pkg-test1.zip http://localhost:9999/update-test/pkg-test3.zip"
"pkg-test1 pkg-test3"
$ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n"
$ "cp -f test-pkgs/pkg-test3.zip test-pkgs/update-test/pkg-test3.zip"
$ "cp -f test-pkgs/pkg-test3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
$ "raco pkg update pkg-test3" =exit> 0
$ "racket -e '(require pkg-test3)'" =stdout> "pkg-test3/main loaded\n")
(finally
$ "rm -f test-pkgs/update-test/pkg-test3.zip"
$ "rm -f test-pkgs/update-test/pkg-test3.zip.CHECKSUM"))
(shelly-wind
$ "mkdir -p test-pkgs/update-test"
$ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip"