From 27b7e7dc7e3ddc83e711b5f27fc2d0d5ce1f47fd Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 22 Apr 2013 10:16:24 -0600
Subject: [PATCH] pkg/lib: add `pkg-index-update-local' and
 `pkg-index-suggestions-for-module'

Assembles other functions to create and consult a local database of
packages and the modules that the packages implement.
---
 collects/pkg/lib.rkt               | 71 ++++++++++++++++++++++++++++++
 collects/pkg/pnr-db.rkt            |  9 +++-
 collects/pkg/scribblings/lib.scrbl | 24 ++++++++++
 3 files changed, 103 insertions(+), 1 deletion(-)

diff --git a/collects/pkg/lib.rkt b/collects/pkg/lib.rkt
index c88365709e..0c4d725ccf 100644
--- a/collects/pkg/lib.rkt
+++ b/collects/pkg/lib.rkt
@@ -1729,6 +1729,68 @@
    (when clean?
      (delete-directory/files dir))))
 
+
+(define (pkg-index-update-local #:index-file [index-file (db:current-pkg-index-file)]
+                                #:quiet? [quiet? #f])
+  (parameterize ([db:current-pkg-index-file index-file])
+    (define indexes (pkg-config-indexes))
+    (db:set-indexes! indexes)
+
+    (for ([index (in-list indexes)])
+      (parameterize ([current-pkg-indexes (list (string->url index))])
+        (define details (get-all-pkg-details-from-indexes))
+        (db:set-pkgs! index (for/list ([(name ht) (in-hash details)])
+                              (db:pkg name
+                                      index
+                                      (hash-ref ht 'author "")
+                                      (hash-ref ht 'source "")
+                                      (hash-ref ht 'checksum "")
+                                      (hash-ref ht 'description ""))))
+
+        (define need-modules (db:get-pkgs-without-modules #:index index))
+        (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 index checksum modules))))))
+
+
+(define (choose-index-file)
+  (define default (db:current-pkg-index-file))
+  (if (file-exists? default)
+      default
+      (let ([installation (build-path (find-lib-dir) "pkgs" (file-name-from-path default))])
+        (if (file-exists? installation)
+            installation
+            default))))
+
+(define (pkg-index-suggestions-for-module module-path
+                                          #:index-file [index-file (choose-index-file)])
+  (if (file-exists? index-file)
+      (parameterize ([db:current-pkg-index-file index-file])
+        (let* ([mod (collapse-module-path 
+                     module-path
+                     (lambda () (build-path (current-directory) "dummy.rkt")))]
+               [pkgs (db:get-module-pkgs mod)]
+               [more-pkgs (let ([rx:reader #rx"/lang/reader[.]rkt$"])
+                            (if (and (pair? mod)
+                                     (eq? (car mod) 'lib)
+                                     (regexp-match rx:reader (cadr mod)))
+                                (db:get-module-pkgs `(lib ,(regexp-replace rx:reader (cadr mod) "/main.rkt")))
+                                null))])
+          (sort (set->list
+                 (list->set
+                  (map db:pkg-name (append pkgs more-pkgs)))) 
+                string<?)))
+      null))
+  
 (define dep-behavior/c
   (or/c #f 'fail 'force 'search-ask 'search-auto))
 
@@ -1820,6 +1882,15 @@
                           boolean?))]
   [pkg-config-indexes
    (-> (listof string?))]
+  [pkg-index-update-local
+   (->* ()
+        (#:index-file path-string?
+         #:quiet? boolean?)
+        void?)]
+  [pkg-index-suggestions-for-module
+   (->* (module-path?)
+        (#:index-file path-string?)
+        (listof string?))]
   [get-all-pkg-names-from-indexes
    (-> (listof string?))]
   [get-all-pkg-details-from-indexes
diff --git a/collects/pkg/pnr-db.rkt b/collects/pkg/pnr-db.rkt
index 199add5f04..5c98e70467 100644
--- a/collects/pkg/pnr-db.rkt
+++ b/collects/pkg/pnr-db.rkt
@@ -2,6 +2,8 @@
 (require racket/contract/base
          racket/format
          racket/set
+         racket/path
+         racket/file
          db)
 
 (provide 
@@ -85,13 +87,18 @@
   (make-parameter (build-path
                    (find-system-path 'addon-dir)
                    (version)
+                   "pkgs"
                    "pnr.sqlite")))
 
 (define (call-with-pnr-db proc)
   (define db #f)
   (dynamic-wind
       (lambda ()
-        (set! db (sqlite3-connect #:database (current-pkg-index-file)
+        (define file (current-pkg-index-file))
+        (define dir (path-only file))
+        (unless (directory-exists? dir)
+          (make-directory* dir))
+        (set! db (sqlite3-connect #:database file
                                   #:mode 'create
                                   #:busy-retry-limit +inf.0)))
       (lambda () (proc db))
diff --git a/collects/pkg/scribblings/lib.scrbl b/collects/pkg/scribblings/lib.scrbl
index bcb1204e98..c8dca73255 100644
--- a/collects/pkg/scribblings/lib.scrbl
+++ b/collects/pkg/scribblings/lib.scrbl
@@ -4,6 +4,7 @@
                      racket/contract/base
                      pkg
                      pkg/lib
+                     (only-in pkg/pnr-db current-pkg-index-file)
                      net/url
                      syntax/modcollapse
                      setup/getinfo))
@@ -239,6 +240,29 @@ then @racket[names] should be empty.}
 Implements the @racket[index-copy] command.}
 
 
+@defproc[(pkg-index-update-local [#:index-file index-file path-string? (current-pkg-index-file)]
+                                 [#:quiet? quiet? boolean? #f])
+         void?]{
+
+Consults the user's configured @tech{package name resolvers} (like
+@racket[pkg-index-copy]) and package servers to populate the database
+@racket[index-file] with information about available packages and the
+modules that they implement.}
+
+
+@defproc[(pkg-index-suggestions-for-module 
+          [module-path module-path?]
+          [#:index-file index-file path-string? ....])
+         (listof string?)]{
+
+Consults @racket[index-file] and returns a list of available packages
+that provide the module specified by @racket[module-path].
+
+The default @racket[index-file] is @racket[(current-pkg-index-file)]
+if that file exists, otherwise a file in the racket installation is
+tried.}
+
+
 @defproc[(get-all-pkg-names-from-indexes) (listof string?)]{
 
 Consults @tech{package name resolvers} to obtain a list of available