pkg/pnr-db: add `get-pkgs-without-modules'

Also, by default, clear out information for old checksums when
setting a package's information.

collects/pkg/pnr-db.rkt

@@ -13,16 +13,20 @@
   [get-indexes (-> (listof string?))]
   [set-indexes! ((listof string?) . -> . void?)]
 
-  [set-pkgs! (string? (listof (or/c pkg? string?)) . -> . void?)]
+  [set-pkgs! ((string? (listof (or/c pkg? string?)))
+              (#:clear-other-checksums? boolean?)
+              . ->* . 
+              void?)]
 
   [get-pkgs (()
              (#:name (or/c #f string?)
                      #:index (or/c #f string?))
              . ->* .
              (listof pkg?))]
-  [set-pkg! (string? string? string? string? string? string?
+  [set-pkg! ((string? string? string? string? string? string?)
-                     . -> .
+             (#:clear-other-checksums? boolean?)
-                     void?)]
+             . ->* .
+             void?)]
 
   [get-pkg-modules (string? string? string?
                             . -> . (listof module-path?))]
@@ -35,7 +39,12 @@
   [set-pkg-tags! (string? string? (listof string?)
                           . -> . void?)]
 
-  [get-module-pkgs (module-path? . -> . pkg?)]))
+  [get-module-pkgs (module-path? . -> . pkg?)]
+
+  [get-pkgs-without-modules (()
+                             (#:index string?)
+                             . ->* .
+                             (listof pkg?))]))
 
 (struct pkg (name index author source checksum desc)
   #:transparent)
@@ -124,7 +133,8 @@
             (vector-ref row 4)
             (vector-ref row 5))))))
 
-(define (set-pkg! name index author source checksum desc)
+(define (set-pkg! name index author source checksum desc
+                  #:clear-other-checksums? [clear-other-checksums? (not (equal? checksum ""))])
   (call-with-pnr-db
    (lambda (db)
      (prepare-pnr-table db)
@@ -140,6 +150,13 @@
                    " AND   pnr=$6")
                author source checksum desc
                name pnr)
+        (when clear-other-checksums?
+          (query-exec db
+                      (~a "DELETE FROM modules"
+                          " WHERE pnr=$1 AND pkg=$2 AND checksum<>$3")
+                      pnr
+                      name
+                      checksum))
         (void))))))
 
 (define (get-pkg-tags name index)
@@ -241,6 +258,40 @@
 (define (mod->string mp) (~s mp))
 (define (string->mod str) (read (open-input-string str)))
 
+(define (get-pkgs-without-modules #:index [index #f])
+  (call-with-pnr-db
+   (lambda (db)
+     (prepare-pnr-table db)
+     (prepare-pkg-table db)
+     (prepare-modules-table db)
+     (define rows
+       (apply
+        query-rows
+        db
+        (~a "SELECT K.name, N.url, K.checksum"
+            " FROM pkg K, pnr N"
+            " WHERE N.id = K.pnr"
+            (if index
+                " AND  N.url = $1"
+                "")
+            " AND NOT EXISTS"
+            " (SELECT M.name"
+            "  FROM modules M"
+            "  WHERE M.pkg = K.name"
+            "   AND  M.pnr = K.pnr"
+            "   AND  M.checksum = K.checksum)")
+        (append
+         (if index
+             (list index)
+             null))))
+     (for/list ([row (in-list rows)])
+       (pkg (vector-ref row 0)
+            (vector-ref row 1)
+            ""
+            ""
+            (vector-ref row 2)
+            "")))))
+
 (define (get-indexes)
   (call-with-pnr-db
    (lambda (db)
@@ -301,7 +352,8 @@
                "SELECT id FROM pnr WHERE url=$1"
                url))
 
-(define (set-pkgs! url pkgs)
+(define (set-pkgs! url pkgs
+                   #:clear-other-checksums? [clear-other-checksums? #t])
   (call-with-pnr-db
    (lambda (db)
      (prepare-pnr-table db)
@@ -323,21 +375,29 @@
         (for ([old (in-list current-pkgs)])
           (unless (set-member? new-pkgs old)
             (query-exec db
-                        "DELETE FROM pkg WHERE pnr=$1, name=$2"
+                        "DELETE FROM pkg WHERE pnr=$1 AND name=$2"
                         pnr
                         old)
             (query-exec db
-                        "DELETE FROM tags WHERE pnr=$1, pkg=$2"
+                        "DELETE FROM tags WHERE pnr=$1 AND pkg=$2"
                         pnr
                         old)
             (query-exec db
-                        "DELETE FROM modules WHERE pnr=$1, pkg=$2"
+                        "DELETE FROM modules WHERE pnr=$1 AND pkg=$2"
                         pnr
                         old)))
         (for ([new0 (in-list pkgs)])
           (define new (if (pkg? new0) 
                           new0
                           (pkg new0 "" "" "" "" "")))
+          (when (and clear-other-checksums?
+                     (not (equal? "" (pkg-checksum new))))
+            (query-exec db
+                        (~a "DELETE FROM modules"
+                            " WHERE pnr=$1 AND pkg=$2 AND checksum<>$3")
+                        pnr
+                        (pkg-name new)
+                        (pkg-checksum new)))
           (unless (and (string? new0)
                        (set-member? old-pkgs new0))
             (if (set-member? old-pkgs (pkg-name new))

collects/pkg/scribblings/pnr-db.scrbl

@@ -69,7 +69,8 @@ The result list is ordered by precedence of the @tech{package name
 resolver}.}
 
 
-@defproc[(set-pkgs! [index string?] [pkgs (listof (or/c string? pkg?))])
+@defproc[(set-pkgs! [index string?] [pkgs (listof (or/c string? pkg?))]
+                    [#:clear-other-checksums? clear-other-checksums? #t])
          void?]{
 
 Sets the list of all packages that are recognized by the
@@ -79,7 +80,12 @@ Information about any other package for @racket[index] is removed from
 the database.  If a string is provided for @racket[pkgs], it is
 treated as a package name; if additional information is already
 recorded in the database for the package name, then the additional
-information is preserved.}
+information is preserved.
+
+If @racket[clear-other-checksums?] is true, then for each element of
+@racket[pkgs] that has a given checksum other than @racket[""], any
+information in the database specific to another checksum (such as a
+list of module paths) is removed from the database.}
 
 
 @defproc[(set-pkg! [name string?]
@@ -87,11 +93,16 @@ information is preserved.}
                    [author string?]
                    [source string?]
                    [checksum string?]
-                   [desc string?])
+                   [desc string?]
+                   [#:clear-other-checksums? clear-other-checksums? (not (equal? checksum ""))])
            void?]{
 
 Sets the information for a specific package @racket[name] as
-recognized by the @tech{package name resolver} @racket[index].}
+recognized by the @tech{package name resolver} @racket[index].
+
+If @racket[clear-other-checksums?] is true, then information (such as
+a list of module paths) is removed from the database when it is
+specific to a checksum other than @racket[checksum].}
 
 
 @deftogether[(
@@ -118,3 +129,13 @@ Gets or sets a list of tags for the package
 Gets or sets a list of module paths that are provided for the package
 @racket[name] as recognized by the @tech{package name resolver}
 @racket[index] and for a specific @tech{checksum}.}
+
+
+@defproc[(get-pkgs-without-modules [#:index index (or/c #f string?) #f])
+         (listof pkg?)]{
+
+Returns a list of packages (optionally constrained to @racket[index])
+for which the database has no modules recorded.
+
+Each resulting @racket[pkg] has its @racket[name], @racketidfont{index}, and
+@racket[checksum] field set, but other fields may be @racket[""].}