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

pkg catalog operations: store and propagate ring number

Browse Source 
Although `raco pkg` doesn't use a package's ring number, it's useful
to preserve for other tools (like the pkg-build service). Adjust `raco
pkg catalog-copy` and `raco pkg catalog-info` to recognize and store a
ring number.
This commit is contained in:
Matthew Flatt 2017-08-22 16:55:10 -06:00
parent 8257a592a0
commit ff1ec66c7f
9 changed files with 120 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
pkgs/racket-doc/pkg/scribblings/catalog-protocol.scrbl
View File

@ -1,7 +1,8 @@
#lang scribble/manual
@(require scribble/bnf
"common.rkt"
(for-label syntax/modcollapse))
(for-label syntax/modcollapse
(only-in pkg/db get-pkg-ring)))
@title[#:tag "catalog-protocol"]{Package Catalog Protocol}
@ -94,6 +95,10 @@ information about packages:
clients at version 5.3.6 and earlier (which do not check
for @racket['versions]).}
@item{@racket['ring] (optional) --- either @racket[#f] or a
ring number. See @racket[get-pkg-ring] for more
information.}
]}
@ -217,4 +222,15 @@ constructed in any way as long as it contains the following tables:
This table is not currently used by any @exec{raco pkg}
command.}
@item{A @tt{ring} table with the form
@verbatim[#:indent 2]{(pkg TEXT,
catalog SMALLINT,
ring SMALLINT)}
where the @tt{pkg} and @tt{catalog} combination identifies a unique
row in @tt{pkg}.
@history[#:added "6.10.0.3"]}
]

20
pkgs/racket-doc/pkg/scribblings/db.scrbl
View File

@ -130,6 +130,26 @@ Gets or sets a list of tags for the package
@racket[catalog].}
@deftogether[(
@defproc[(get-pkg-ring [name string?] [catalog string?])
(or/c #f exact-nonnegative-integer?)]
@defproc[(set-pkg-ring! [name string?] [catalog string?] [ring (or/c #f exact-nonnegative-integer?)])
void?]
)]{
Gets or sets a ring number for the package @racket[name] as recognized
by the @tech{package catalog} @racket[catalog].
The PLT-supported package catalog reports a curated ring number to
reflect advice on package preference and conflicts, where the set of
ring-0 and ring-1 packages are expected to have no conflicts (that is,
no multiply defined modules, document names, etc.). The @exec{raco
pkg} tool does not pay attention to a package's ring number, but other
uses of a catalog may consult ring numbers.
@history[#:added "6.10.0.3"]}
@deftogether[(
@defproc[(get-pkg-dependencies [name string?] [catalog string?] [checksum string?])
(listof list?)]

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

@ -976,9 +976,9 @@ for @nonterm{key}.
@itemlist[
@item{@DFlag{all} --- Shows information for all available packages. When using this flag,
supply no @nonterm{packaee-name}s.}
supply no @nonterm{package-name}s.}
@item{@DFlag{only-names} --- Shows only package names. This option is mainly useful with
@DFlag{all}, but when a @nonterm{packaee-name} is provided,
@DFlag{all}, but when a @nonterm{package-name} is provided,
catalogs are consulted to ensure that he package is available.}
@item{@DFlag{modules} --- Shows the modules that are implemented by a package.}
@item{@DFlag{catalog} @nonterm{catalog} --- Queries @nonterm{catalog} instead of the currently configured

13
pkgs/racket-test/tests/pkg/tests-catalogs.rkt
View File

@ -40,17 +40,20 @@
"Not a whale"))))
(db:set-pkg-modules! "fish" "local" "123" '((lib "fish/main.rkt") (lib "fish/food.rkt")))
(db:set-pkg-dependencies! "fish" "local" "123"
'("ocean" ("water" "1.0") ("crash-helmet" #:platform windows))))
'("ocean" ("water" "1.0") ("crash-helmet" #:platform windows)))
(db:set-pkg-ring! "fish" "local" 2))
$ "raco pkg catalog-show fish" =stdout> #rx"Checksum: 123"
$ "raco pkg catalog-show fish" =stdout> #rx"ocean"
$ "raco pkg catalog-show fish" =stdout> #rx"water version 1.0"
$ "raco pkg catalog-show fish" =stdout> #rx"crash-helmet on platform 'windows"
$ "raco pkg catalog-show fish" =stdout> #rx"Ring: 2"
$ "raco pkg catalog-show --modules fish" =stdout> #rx"fish/food"
$ (~a "raco pkg catalog-copy " (path->string db) " " (path->string dir))
$ (~a "raco pkg config --set catalogs file://" (path->string dir))
$ "raco pkg catalog-show fish" =stdout> #rx"Checksum: 123"
$ "raco pkg catalog-show fish" =stdout> #rx"Ring: 2"
$ "raco pkg catalog-show --only-names fish" =stdout> #rx"fish"
$ "raco pkg catalog-show --only-names --all" =stdout> #rx"fish"
$ "raco pkg catalog-show --modules fish" =stdout> #rx"fish/food"
@ -59,6 +62,7 @@
(delete-file (build-path dir "pkgs"))
(delete-file (build-path dir "pkgs-all"))
$ "raco pkg catalog-show fish" =stdout> #rx"Checksum: 123"
$ "raco pkg catalog-show fish" =stdout> #rx"Ring: 2"
$ "raco pkg catalog-show --only-names fish" =stdout> #rx"^fish"
$ "raco pkg catalog-show --only-names --all" =stdout> #rx"^fish"
$ "raco pkg catalog-show --modules fish" =stdout> #rx"fish/food"
@ -82,21 +86,26 @@
'source "http://localhost:9997/whale.plt"
'versions (hash "5.3.6"
(hash 'checksum
123)))
123))
'ring 1)
o))))
(add-whale! "345")
$ (~a "raco pkg catalog-show --catalog file://" (path->string dir2) " whale")
=stdout> #rx"Checksum: 345"
$ (~a "raco pkg catalog-show --catalog file://" (path->string dir2) " whale")
=stdout> #rx"Ring: 1"
$ (~a "raco pkg catalog-show --version 5.3.6 --catalog file://" (path->string dir2) " whale")
=stdout> #rx"Checksum: 123"
$ "raco pkg catalog-show whale" =exit> 1
$ (~a "raco pkg catalog-copy --merge " (path->string dir2) " " (path->string dest))
$ "raco pkg catalog-show whale" =stdout> #rx"Checksum: 345"
$ "raco pkg catalog-show whale" =stdout> #rx"Ring: 1"
(add-whale! "567")
$ (~a "raco pkg catalog-copy --merge " (path->string dir2) " " (path->string dest))
$ "raco pkg catalog-show whale" =stdout> #rx"Checksum: 345"
$ "raco pkg catalog-show whale" =stdout> #rx"Ring: 1"
$ (~a "raco pkg catalog-copy --merge --override " (path->string dir2) " " (path->string dest))
$ "raco pkg catalog-show whale" =stdout> #rx"Checksum: 567"))

8
pkgs/racket-test/tests/pkg/tests-db.rkt
View File

@ -60,6 +60,14 @@
(check-equal? (get-pkg-tags "p1" "http://a")
'())
(check-equal? (get-pkg-ring "p2" "http://b")
#f)
(set-pkg-ring! "p2" "http://b" 2)
(check-equal? (get-pkg-ring "p2" "http://b")
2)
(check-equal? (get-pkg-ring "p1" "http://a")
#f)
(set-pkg-modules! "p1" "http://a" "123" (list '(lib "lib1/main.rkt")
'(lib "lib2/main.rkt")))
(check-equal? (sort (get-pkg-modules "p1" "http://a" "123")

50
racket/collects/pkg/db.rkt
View File

@ -51,6 +51,11 @@
[set-pkg-tags! (string? string? (listof string?)
. -> . void?)]
[get-pkg-ring (string? string?
. -> . (or/c #f exact-nonnegative-integer?))]
[set-pkg-ring! (string? string? (or/c #f exact-nonnegative-integer?)
. -> . void?)]
[get-module-pkgs (module-path? . -> . (listof pkg?))]
[get-pkgs-without-modules (()
@ -120,6 +125,15 @@
;; index:
"(pkg, catalog, checksum)"))
(define (prepare-ring-table db)
(prepare-table db
"ring"
(~a "(pkg TEXT,"
" catalog SMALLINT,"
" ring SMALLINT)")
;; index:
"(pkg, catalog)"))
(define current-pkg-catalog-file
(make-parameter (build-path
(find-system-path 'addon-dir)
@ -446,6 +460,42 @@
[else (get-keyed (cdr dep) '#:platform platform->string)])
name catalog-id checksum)))))))
(define (get-pkg-ring name catalog)
(call-with-catalog-db
(lambda (db)
(prepare-catalog-table db)
(prepare-pkg-table db)
(prepare-ring-table db)
(define catalog-id (url->catalog db catalog))
(query-maybe-value (catalog-db-connection db)
(~a "SELECT ring FROM ring"
" WHERE catalog=$1"
" AND pkg=$2")
catalog-id
name))))
(define (set-pkg-ring! name catalog ring)
(call-with-catalog-db
(lambda (db)
(prepare-catalog-table db)
(prepare-pkg-table db)
(prepare-ring-table db)
(call-with-catalog-transaction
db
(lambda ()
(define catalog-id (url->catalog db catalog))
(query-exec (catalog-db-connection db)
(~a "DELETE FROM ring"
" WHERE catalog=$1"
" AND pkg=$2")
catalog-id
name)
(when ring
(query-exec (catalog-db-connection db)
(~a "INSERT INTO ring"
" VALUES ($1, $2, $3)")
name catalog-id ring)))))))
(define (platform->string dep) (~s dep))
(define (string->platform str) (read (open-input-string str)))

7
racket/collects/pkg/private/catalog-copy.rkt
View File

@ -142,7 +142,11 @@
(define deps (hash-ref v 'dependencies '()))
(unless (null? deps)
(define cs (hash-ref v 'checksum ""))
(db:set-pkg-dependencies! k "local" cs deps))))]
(db:set-pkg-dependencies! k "local" cs deps)))
(for ([(k v) (in-hash vers-details)])
(define ring (hash-ref v 'ring #f))
(when ring
(db:set-pkg-ring! k "local" ring))))]
[else
(define pkg-path (build-path dest-path "pkg"))
(make-directory* pkg-path)
@ -159,4 +163,3 @@
#:exists 'truncate/replace
(build-path dest-path "pkgs-all")
(lambda (o) (write details o)))]))

2
racket/collects/pkg/private/catalog-show.rkt
View File

@ -43,7 +43,7 @@
(get-pkg-details-from-catalogs name))))
(unless (zero? position) (newline))
(printf "Package name: ~a\n" name)
(for ([key '(author source checksum tags description)])
(for ([key '(author source checksum tags description ring)])
(define v (hash-ref details key #f))
(when v
(printf " ~a: ~a\n"

7
racket/collects/pkg/private/catalog.rkt
View File

@ -244,7 +244,9 @@
(db:pkg-checksum pkg))]
[deps (db:get-pkg-dependencies (db:pkg-name pkg)
(db:pkg-catalog pkg)
(db:pkg-checksum pkg))])
(db:pkg-checksum pkg))]
[ring (db:get-pkg-ring (db:pkg-name pkg)
(db:pkg-catalog pkg))])
(hash 'name (db:pkg-name pkg)
'author (db:pkg-author pkg)
'source (db:pkg-source pkg)
@ -252,7 +254,8 @@
'description (db:pkg-desc pkg)
'tags tags
'modules mods
'dependencies deps))
'dependencies deps
'ring ring))
(hash 'source (db:pkg-source pkg)
'checksum (db:pkg-checksum pkg))))