diff --git a/collects/pkg/db.rkt b/collects/pkg/db.rkt index 5f4532ae70..95bd683aed 100644 --- a/collects/pkg/db.rkt +++ b/collects/pkg/db.rkt @@ -4,6 +4,7 @@ racket/set racket/path racket/file + version/utils db) (provide @@ -36,6 +37,12 @@ (listof module-path?) . -> . void?)] + [get-pkg-dependencies (string? string? string? + . -> . (listof dep/c))] + [set-pkg-dependencies! (string? string? string? + (listof dep/c) + . -> . void?)] + [get-pkg-tags (string? string? . -> . (listof string?))] [set-pkg-tags! (string? string? (listof string?) @@ -48,6 +55,15 @@ . ->* . (listof pkg?))])) +(define platform/c (or/c string? symbol? regexp?)) +(define dep/c (or/c string? + (list/c string?) + (list/c string? string?) + (list/c string? '#:version valid-version?) + (list/c string? '#:platform platform/c) + (list/c string? '#:version valid-version? '#:platform platform/c) + (list/c string? '#:platform platform/c '#:version valid-version?))) + (struct pkg (name catalog author source checksum desc) #:transparent) @@ -83,6 +99,16 @@ " catalog SMALLINT," " checksum TEXT)"))) +(define (prepare-dependencies-table db) + (prepare-table db + "dependencies" + (~a "(onpkg TEXT," + " onversion TEXT," + " onplatform TEXT," + " pkg TEXT," + " catalog SMALLINT," + " checksum TEXT)"))) + (define current-pkg-catalog-file (make-parameter (build-path (find-system-path 'addon-dir) @@ -163,6 +189,12 @@ " WHERE catalog=$1 AND pkg=$2 AND checksum<>$3") catalog-id name + checksum) + (query-exec db + (~a "DELETE FROM dependencies" + " WHERE catalog=$1 AND pkg=$2 AND checksum<>$3") + catalog-id + name checksum)) (void)))))) @@ -299,6 +331,79 @@ (vector-ref row 2) ""))))) +(define (get-pkg-dependencies name catalog checksum) + (call-with-catalog-db + (lambda (db) + (prepare-catalog-table db) + (prepare-pkg-table db) + (prepare-dependencies-table db) + (define catalog-id (url->catalog db catalog)) + (define rows + (query-rows db + (~a "SELECT onpkg, onversion, onplatform" + " FROM dependencies" + " WHERE catalog=$1" + " AND pkg=$2" + " AND checksum=$3") + catalog-id + name + checksum)) + (for/list ([row (in-list rows)]) + (define on-pkg (vector-ref row 0)) + (define on-version (vector-ref row 1)) + (define on-platform (vector-ref row 2)) + (cons on-pkg + (append + (if (equal? on-version "") + null + (list '#:version on-version)) + (if (equal? on-platform "") + null + (list '#:platform (string->platform on-platform))))))))) + +(define (set-pkg-dependencies! name catalog checksum dependencies) + (define (get-keyed l k wrap) + (define a (memq k l)) + (if a (wrap (cadr a)) "")) + (call-with-catalog-db + (lambda (db) + (prepare-catalog-table db) + (prepare-pkg-table db) + (prepare-dependencies-table db) + (call-with-transaction + db + (lambda () + (define catalog-id (url->catalog db catalog)) + (query-exec db + (~a "DELETE FROM dependencies" + " WHERE catalog=$1" + " AND pkg=$2" + " AND checksum=$3") + catalog-id + name + checksum) + (for ([dep (in-list dependencies)]) + (query db + (~a "INSERT INTO dependencies" + " VALUES ($1, $2, $3, $4, $5, $6)") + (cond + [(string? dep) dep] + [else (car dep)]) + (cond + [(string? dep) ""] + [(and (list? dep) (= 2 (length dep))) + (cadr dep)] + [else (get-keyed (cdr dep) '#:version values)]) + (cond + [(string? dep) ""] + [(and (list? dep) (= 2 (length dep))) + ""] + [else (get-keyed (cdr dep) '#:platform platform->string)]) + name catalog-id checksum))))))) + +(define (platform->string dep) (~s dep)) +(define (string->platform str) (read (open-input-string str))) + (define (get-catalogs) (call-with-catalog-db (lambda (db) @@ -313,6 +418,7 @@ (prepare-pkg-table db) (prepare-tags-table db) (prepare-modules-table db) + (prepare-dependencies-table db) (call-with-transaction db (lambda () @@ -335,6 +441,9 @@ old-id) (query-exec db "DELETE FROM modules WHERE catalog=$1" + old-id) + (query-exec db + "DELETE FROM dependencies WHERE catalog=$1" old-id))) (for ([new-url (in-list urls)]) (unless (member new-url old-urls) @@ -366,6 +475,7 @@ (prepare-catalog-table db) (prepare-pkg-table db) (prepare-modules-table db) + (prepare-dependencies-table db) (call-with-transaction db (lambda () @@ -392,6 +502,10 @@ (query-exec db "DELETE FROM modules WHERE catalog=$1 AND pkg=$2" catalog + old) + (query-exec db + "DELETE FROM dependencies WHERE catalog=$1 AND pkg=$2" + catalog old))) (for ([new0 (in-list pkgs)]) (define new (if (pkg? new0) @@ -404,6 +518,12 @@ " WHERE catalog=$1 AND pkg=$2 AND checksum<>$3") catalog (pkg-name new) + (pkg-checksum new)) + (query-exec db + (~a "DELETE FROM dependencies" + " WHERE catalog=$1 AND pkg=$2 AND checksum<>$3") + catalog + (pkg-name new) (pkg-checksum new))) (unless (and (string? new0) (set-member? old-pkgs new0)) @@ -508,6 +628,26 @@ (list (pkg "p1" "http://a" "" "" "123" ""))) + (set-pkg-dependencies! "p1" "http://a" "123" (list "p7" + '("p8" "8.0") + '("p9" #:version "9.0") + '("p10" #:platform #rx"linux") + '("p11" #:platform 'windows) + '("p12" #:version "1.2" #:platform 'macosx) + '("p13" #:platform 'unix #:version "1.3.2") + '("p14" #:platform ""))) + (check-equal? (sort (get-pkg-dependencies "p1" "http://a" "123") + stringversion dep) (cond [(string? dep) #f] + [(null? (cdr dep)) #f] [(keyword? (cadr dep)) (dependency-lookup '#:version dep)] [else (cadr dep)])) @@ -214,6 +215,7 @@ (define (dependency-lookup kw dep) (cond [(string? dep) #f] + [(null? (cdr dep)) #f] [(keyword? (cadr dep)) (define p (member kw (cdr dep))) (and p (cadr p))] @@ -340,13 +342,21 @@ (define (db-pkg-info pkg details?) (if details? (let ([tags (db:get-pkg-tags (db:pkg-name pkg) - (db:pkg-catalog pkg))]) + (db:pkg-catalog pkg))] + [mods (db:get-pkg-modules (db:pkg-name pkg) + (db:pkg-catalog pkg) + (db:pkg-checksum pkg))] + [deps (db:get-pkg-dependencies (db:pkg-name pkg) + (db:pkg-catalog pkg) + (db:pkg-checksum pkg))]) (hash 'name (db:pkg-name pkg) 'author (db:pkg-author pkg) 'source (db:pkg-source pkg) 'checksum (db:pkg-checksum pkg) 'description (db:pkg-desc pkg) - 'tags tags)) + 'tags tags + 'modules mods + 'dependencies deps)) (hash 'source (db:pkg-source pkg) 'checksum (db:pkg-source pkg)))) @@ -1562,7 +1572,17 @@ (for ([(k v) (in-hash details)]) (define t (hash-ref v 'tags '())) (unless (null? t) - (db:set-pkg-tags! k "local" t))))] + (db:set-pkg-tags! k "local" t))) + (for ([(k v) (in-hash details)]) + (define mods (hash-ref v 'modules '())) + (unless (null? mods) + (define cs (hash-ref v 'checksum "")) + (db:set-pkg-modules! k "local" cs mods))) + (for ([(k v) (in-hash details)]) + (define deps (hash-ref v 'dependencies '())) + (unless (null? deps) + (define cs (hash-ref v 'checksum "")) + (db:set-pkg-dependencies! k "local" cs deps))))] [else (define pkg-path (build-path dest-path "pkg")) (make-directory* pkg-path) @@ -1582,7 +1602,8 @@ (define (pkg-catalog-show names #:all? [all? #f] - #:only-names? [only-names? #f]) + #:only-names? [only-names? #f] + #:modules? [modules? #f]) (for ([name (in-list names)]) (define-values (parsed-name type) (package-source->name+type name #f)) @@ -1618,7 +1639,40 @@ (string-titlecase (symbol->string key)) (if (list? v) (apply ~a #:separator ", " v) - v)))))])) + v)))) + (for ([key '(dependencies)]) + (define v (hash-ref details key null)) + (unless (null? v) + (printf " Dependencies:\n") + (for ([dep (in-list v)]) + (define vers (dependency->version dep)) + (define plat (dependency-lookup '#:platform dep)) + (printf " ~a~a~a\n" + (dependency->name dep) + (if vers + (format " version ~a" vers) + "") + (if plat + (format " on platform ~v" plat) + ""))))) + (when modules? + (printf "Modules:") + (for/fold ([col 72]) ([mod (in-list (hash-ref details 'modules null))]) + (define pretty-mod (if (and (list? mod) + (= 2 (length mod)) + (eq? (car mod) 'lib) + (regexp-match #rx"[.]rkt$" (cadr mod))) + (string->symbol (regexp-replace #rx"[.]rkt$" (cadr mod) "")) + mod)) + (define mod-str (~a " " pretty-mod)) + (define new-col (if ((+ col (string-length mod-str)) . > . 72) + (begin + (newline) + 0) + col)) + (display mod-str) + (+ new-col (string-length mod-str))) + (newline)))])) (define (get-all-pkg-names-from-catalogs) (define ht @@ -1740,7 +1794,8 @@ (define (pkg-catalog-update-local #:catalog-file [catalog-file (db:current-pkg-catalog-file)] - #:quiet? [quiet? #f]) + #:quiet? [quiet? #f] + #:consult-packages? [consult-packages? #f]) (parameterize ([db:current-pkg-catalog-file catalog-file]) (define catalogs (pkg-config-catalogs)) (db:set-catalogs! catalogs) @@ -1748,28 +1803,40 @@ (for ([catalog (in-list catalogs)]) (parameterize ([current-pkg-catalogs (list (string->url catalog))]) (define details (get-all-pkg-details-from-catalogs)) + ;; set packages: (db:set-pkgs! catalog (for/list ([(name ht) (in-hash details)]) - (db:pkg name - catalog - (hash-ref ht 'author "") - (hash-ref ht 'source "") - (hash-ref ht 'checksum "") - (hash-ref ht 'description "")))) - - (define need-modules (db:get-pkgs-without-modules #:catalog catalog)) - (for ([(pkg) (in-list need-modules)]) - (define name (db:pkg-name pkg)) - (define ht (hash-ref details name)) - (define source (hash-ref ht 'source)) - (unless quiet? - (printf "Downloading ~s\n" source)) - (define-values (checksum modules deps) - (get-pkg-content (pkg-desc source - #f - (hash-ref ht 'checksum #f) - #f))) - (db:set-pkg-modules! name catalog checksum modules)))))) - + (db:pkg name + catalog + (hash-ref ht 'author "") + (hash-ref ht 'source "") + (hash-ref ht 'checksum "") + (hash-ref ht 'description "")))) + ;; Add available module and dependency info: + (for/list ([(name ht) (in-hash details)]) + (define checksum (hash-ref ht 'checksum "")) + (define mods (hash-ref ht 'modules #f)) + (when mods + (db:set-pkg-modules! name catalog checksum mods)) + (define deps (hash-ref ht 'dependencies #f)) + (when deps + (db:set-pkg-dependencies! name catalog checksum deps))) + (when consult-packages? + ;; If module information isn't available for a package, download + ;; the package to fill in that information: + (define need-modules (db:get-pkgs-without-modules #:catalog catalog)) + (for ([(pkg) (in-list need-modules)]) + (define name (db:pkg-name pkg)) + (define ht (hash-ref details name)) + (define source (hash-ref ht 'source)) + (unless quiet? + (printf "Downloading ~s\n" source)) + (define-values (checksum modules deps) + (get-pkg-content (pkg-desc source + #f + (hash-ref ht 'checksum #f) + #f))) + (db:set-pkg-modules! name catalog checksum modules) + (db:set-pkg-dependencies! name catalog checksum deps))))))) (define (choose-catalog-file) (define default (db:current-pkg-catalog-file)) @@ -1865,7 +1932,8 @@ [pkg-catalog-show (->* ((listof string?)) (#:all? boolean? - #:only-names? boolean?) + #:only-names? boolean? + #:modules? boolean?) void?)] [pkg-catalog-copy (->* ((listof path-string?) path-string?) @@ -1894,7 +1962,8 @@ [pkg-catalog-update-local (->* () (#:catalog-file path-string? - #:quiet? boolean?) + #:quiet? boolean? + #:consult-packages? boolean?) void?)] [pkg-catalog-suggestions-for-module (->* (module-path?) diff --git a/collects/pkg/main.rkt b/collects/pkg/main.rkt index 01e354d849..08743432c2 100644 --- a/collects/pkg/main.rkt +++ b/collects/pkg/main.rkt @@ -232,6 +232,7 @@ #:once-each [#:bool all () "Show all packages"] [#:bool only-names () "Show only package names"] + [#:bool modules () "Show implemented modules"] #:args pkg-name (when (and all (pair? pkg-name)) ((pkg-error 'catalog-show) "both `--all' and package names provided")) @@ -240,7 +241,8 @@ [current-pkg-error (pkg-error 'catalog-show)]) (pkg-catalog-show pkg-name #:all? all - #:only-names? only-names))] + #:only-names? only-names + #:modules? modules))] [catalog-copy "Copy/merge package name catalogs" #:once-each diff --git a/collects/pkg/scribblings/catalog-protocol.scrbl b/collects/pkg/scribblings/catalog-protocol.scrbl index bb2624bbc2..80aea5f277 100644 --- a/collects/pkg/scribblings/catalog-protocol.scrbl +++ b/collects/pkg/scribblings/catalog-protocol.scrbl @@ -1,6 +1,7 @@ #lang scribble/manual @(require scribble/bnf - "common.rkt") + "common.rkt" + (for-label syntax/modcollapse)) @title[#:tag "catalog-protocol"]{Package Catalog Protocol} @@ -61,6 +62,16 @@ information about packages: @item{@racket['tags] --- a list of strings that describe the package's categorization.} + @item{@racket['dependencies] --- a list of dependencies for + the package, in the same shape as a @racket[deps] + @filepath{info.rkt} field as described in + @secref["metadata"].} + + @item{@racket['modules] --- a list of module paths for modules + that are provided by th package; each module path should + be normalized in the sense of + @racket[collapse-module-path].} + ]} @item{@litchar{pkgs} path element: Obtains a list of package names @@ -159,10 +170,27 @@ constructed in any way as long as it contains the following tables: checksum TEXT)} where the @tt{pkg} and @tt{catalog} combination identifies a unique - row in @tt{pkg}, and @racket[name] is a printed module path. + row in @tt{pkg}, and @tt{name} is a printed module path. This table is not currently used by any @exec{raco pkg} command, but it can be used to suggest package installations to provide a particular library.} + @item{A @tt{dependencies} table with the form + + @verbatim[#:indent 2]{(onpkg TEXT, + onversion TEXT, + onplatform TEXT, + pkg TEXT, + catalog SMALLINT, + checksum TEXT)} + + where the @tt{pkg} and @tt{catalog} combination identifies a unique + row in @tt{pkg}, and @tt{onpkg}, @tt{onversion}, and @tt{onplatform} + represent the dependency; @tt{onversion} or @tt{onplatform} is an + empty string if the dependency has no version or platform specification. + + This table is not currently used by any @exec{raco pkg} + command.} + ] diff --git a/collects/pkg/scribblings/db.scrbl b/collects/pkg/scribblings/db.scrbl index bcb9511761..03ad9fda19 100644 --- a/collects/pkg/scribblings/db.scrbl +++ b/collects/pkg/scribblings/db.scrbl @@ -118,6 +118,27 @@ Gets or sets a list of tags for the package @racket[catalog].} +@deftogether[( +@defproc[(get-pkg-dependencies [name string?] [catalog string?] [checksum string?]) + (listof list?)] +@defproc[(set-pkg-dependencies! [name string?] [catalog string?] [checksum string?] + [dependencies (listof any/c)]) + void?] +)]{ + +Gets or sets a list of dependencies for the package +@racket[name] as recognized by the @tech{package catalog} +@racket[catalog] and for a specific @tech{checksum}. + +The list of dependencies must have the shape described for a +@racket[deps] @filepath{info.rkt} field as described in +@secref["metadata"]. The result from @racket[get-pkg-dependencies] is +normalized: each dependency is represented by a list, a version in a +dependency is always preceded by @racket['#:version], and if both +version and platform specification are included, @racket['#:version] +appears before @racket['#:platform].} + + @deftogether[( @defproc[(get-pkg-modules [name string?] [catalog string?] [checksum string?]) (listof module-path?)] diff --git a/collects/pkg/scribblings/lib.scrbl b/collects/pkg/scribblings/lib.scrbl index dd804b5dc8..78c375a340 100644 --- a/collects/pkg/scribblings/lib.scrbl +++ b/collects/pkg/scribblings/lib.scrbl @@ -222,7 +222,8 @@ The package lock must be held to allow reads; see @defproc[(pkg-catalog-show [names (listof string?)] [#:all? all? boolean? #f] - [#:only-names? only-names? boolean? #f]) + [#:only-names? only-names? boolean? #f] + [#:modules? modules? boolean? #f]) void?]{ Implements the @racket[catalog-show] command. If @racket[all?] is true, @@ -241,11 +242,13 @@ Implements the @racket[catalog-copy] command.} @defproc[(pkg-catalog-update-local [#:catalog-file catalog-file path-string? (current-pkg-catalog-file)] - [#:quiet? quiet? boolean? #f]) + [#:quiet? quiet? boolean? #f] + [#:consult-packages? consult-packages? boolean? #f]) void?]{ Consults the user's configured @tech{package catalogs} (like -@racket[pkg-catalog-copy]) and package servers to populate the database +@racket[pkg-catalog-copy]) and package servers (if +@racket[consult-packages?] is true) to populate the database @racket[catalog-file] with information about available packages and the modules that they implement.} diff --git a/collects/pkg/scribblings/pkg.scrbl b/collects/pkg/scribblings/pkg.scrbl index ee479c9d39..649a5a0c73 100644 --- a/collects/pkg/scribblings/pkg.scrbl +++ b/collects/pkg/scribblings/pkg.scrbl @@ -394,6 +394,7 @@ View and modify package configuration options. This command accepts the followin @item{@DFlag{only-names} --- Show only package names. This option is mainly useful with @DFlag{all}, but when a @nonterm{packaee-name} is provided, catalogs are consulted to ensure that he package is available.} + @item{@DFlag{modules} --- Show the modules that are implemented by a package.} @item{@DFlag{catalog} @nonterm{catalog} --- Query @nonterm{catalog} instead of the currently configured @tech{package catalogs}.} ] diff --git a/collects/tests/pkg/tests-catalogs.rkt b/collects/tests/pkg/tests-catalogs.rkt index 7661a83582..6318e24382 100644 --- a/collects/tests/pkg/tests-catalogs.rkt +++ b/collects/tests/pkg/tests-catalogs.rkt @@ -33,20 +33,31 @@ (append (db:get-pkgs) (list (db:pkg "fish" "local" "nemo@sub" "http://localhost:9999/fish.zip" "123" - "Not a whale"))))) + "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)))) $ "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 --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 --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" + $ "raco pkg catalog-show fish" =stdout> #rx"water version 1.0" (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 --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" + $ "raco pkg catalog-show fish" =stdout> #rx"water version 1.0" (delete-file (build-path dir "pkg/fish")) $ "raco pkg catalog-show fish" =exit> 1