raco pkg: expose, record, etc., module and dependency information

A package catalog now supplies information about a package's modules
and dependencies, so propagate it when copying a catalog, make the
information accessible via `raco pkg catalog-show', and so on.

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")
+                        string<?
+                        #:key car)
+                  '(("p10" #:platform #rx"linux")
+                    ("p11" #:platform 'windows)
+                    ("p12" #:version "1.2" #:platform 'macosx)
+                    ("p13" #:version "1.3.2" #:platform 'unix)
+                    ("p14" #:platform "")
+                    ("p7")
+                    ("p8" #:version "8.0")
+                    ("p9" #:version "9.0")))
+
     (set-catalogs! '("http://a" "http://c"))
     (check-equal? (sort (get-catalogs) string<?) 
                   '("http://a" "http://c"))

collects/pkg/gui/by-list.rkt

@@ -333,7 +333,13 @@
                                            (hash-ref ht 'checksum "")
                                            (hash-ref ht 'description ""))))
            (for/list ([(name ht) (in-hash details)])
-             (db:set-pkg-tags! name catalog (hash-ref ht 'tags '())))))
+             (db:set-pkg-tags! name catalog (hash-ref ht 'tags '())))
+           (for/list ([(name ht) (in-hash details)])
+             (db:set-pkg-modules! name catalog (hash-ref ht 'checksum "") 
+                                  (hash-ref ht 'modules '())))
+           (for/list ([(name ht) (in-hash details)])
+             (db:set-pkg-dependencies! name catalog (hash-ref ht 'checksum "")
+                                       (hash-ref ht 'dependencies '())))))
        (lambda (finished?)
          (send status-text set-label default-status)
          (set! updating? #f)

collects/pkg/lib.rkt

@@ -207,6 +207,7 @@
 (define (dependency->version 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,6 +1803,7 @@
     (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
@@ -1755,7 +1811,18 @@
                                         (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))
@@ -1768,8 +1835,8 @@
                                          #f 
                                          (hash-ref ht 'checksum #f) 
                                          #f)))
-          (db:set-pkg-modules! name catalog checksum modules))))))
+            (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?)

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

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.}
+
 ]

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?)]

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.}
 

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}.}
  ]

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