pkg catalog operations: store and propagate ring number

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.

pkgs/racket-doc/pkg/scribblings/catalog-protocol.scrbl

@@ -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"]}
+
 ]

pkgs/racket-doc/pkg/scribblings/db.scrbl

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

pkgs/racket-doc/pkg/scribblings/pkg.scrbl

@@ -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 

pkgs/racket-test/tests/pkg/tests-catalogs.rkt

@@ -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"))
 

pkgs/racket-test/tests/pkg/tests-db.rkt

@@ -59,7 +59,15 @@
                   '("2x" "2y" "2z"))
     (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")

racket/collects/pkg/db.rkt

@@ -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)))
 

racket/collects/pkg/private/catalog-copy.rkt

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

racket/collects/pkg/private/catalog-show.rkt

@@ -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"

racket/collects/pkg/private/catalog.rkt

@@ -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))))