raco setup: better tracking of provides in database

Keep track of the out<n>.sxref timestamps, so that `raco setup'
can detect when the database is out of sync (instead of assuming that
it's always in sync with out<n>.sxref files).

pkgs/racket-pkgs/racket-index/setup/scribble.rkt

@@ -810,6 +810,10 @@
                           (and t
                                (let ([t2 (file-or-directory-modify-seconds info-out-file #f (lambda () #f))])
                                  (and t2 (min t t2)))))]
+         [provides-time (for/fold ([t +inf.0]) ([info-out-file info-out-files])
+                          (and t
+                               (let ([t2 (doc-db-get-provides-timestamp db-file info-out-file)])
+                                 (and t2 (min t t2)))))]
          [info-in-time (file-or-directory-modify-seconds info-in-file #f (lambda () #f))]
          [info-time (min (or info-out-time -inf.0) (or info-in-time -inf.0))]
          [vers (send renderer get-serialize-version)]
@@ -823,9 +827,12 @@
               (and (not force-out-of-date?)
                    info-out-time
                    info-in-time
+                   provides-time
                    (or (not can-run?)
                        ;; Need to rebuild if output file is older than input:
                        (my-time . >= . src-time)
+                       ;; Need to rebuild if database is out of sync:
+                       (provides-time . >= . info-out-time)
                        ;; But we can use in/out information if they're already built;
                        ;; this is mostly useful if we interrupt setup-plt after
                        ;; it runs some documents without rendering them:
@@ -923,6 +930,8 @@
                              (not (for/and ([sci scis]
                                             [out-v out-vs])
                                     (serialized=? sci (cadr out-v))))
+                             (not provides-time)
+                             (info-out-time . > . provides-time)
                              (info-out-time . > . (current-seconds)))])
                    (when (and (verbose) need-out-write?)
                      (eprintf " [New out ~a]\n" (doc-src-file doc)))
@@ -1002,7 +1011,9 @@
            lock
            (lambda ()
              (doc-db-clear-provides db-file filename)
-             (doc-db-add-provides db-file provides filename))))))
+             (doc-db-add-provides db-file provides filename)
+             (doc-db-set-provides-timestamp db-file filename 
+                                            (file-or-directory-modify-seconds filename)))))))
     ;; For each ".html" file, check for a reference to "local-redirect.js",
     ;; and fix up the path if there is a reference:
     (define js-path (if (doc-under-main? doc)
@@ -1209,7 +1220,7 @@
                                      (dynamic-require sub 'doc)
                                      (dynamic-require mod-path 'doc))))))))
 
-(define (write- latex-dest vers doc name datas prep!)
+(define (write- latex-dest vers doc name datas prep! final!)
   (let* ([filename (sxref-path latex-dest doc name)])
     (prep! filename)
     (when (verbose) (printf " [Caching to disk ~a]\n" filename))
@@ -1220,9 +1231,22 @@
        (for ([data (in-list datas)])
          (write-bytes (s-exp->fasl (append (list (list vers (doc-flags doc))) 
                                            data)) 
-                      out))))))
+                      out))))
+    (final! filename)))
 
 (define (write-out latex-dest vers doc scis providess db-file lock)
+  ;; A "provides.sxref" file is used when a package is converted to binary
+  ;; form, in which case cross-reference information needs to be loaded
+  ;; into the database at install time:
+  (when (and (doc-pkg? doc)
+             (not (doc-under-main? doc))
+             (not latex-dest))
+    (with-compile-output
+     (sxref-path latex-dest doc "provides.sxref")
+     (lambda (out tmp-filename)
+       (s-exp->fasl providess out))))
+  ;; Write each "out.sxref" file and install the corresponding provides
+  ;; into the database:
   (for ([i (add1 (doc-out-count doc))]
         [sci scis]
         [provides providess])
@@ -1233,15 +1257,14 @@
                lock
                (lambda ()
                  (doc-db-clear-provides db-file filename)
-                 (doc-db-add-provides db-file provides filename))))))
+                 (doc-db-add-provides db-file provides filename))))
-  ;; Used for a package is converted to "binary" form:
+            (lambda (filename)
-  (when (and (doc-pkg? doc)
+              (call-with-lock
-             (not (doc-under-main? doc))
+               lock
-             (not latex-dest))
+               (lambda ()
-    (with-compile-output
+                 (doc-db-set-provides-timestamp
-     (sxref-path latex-dest doc "provides.sxref")
+                  db-file filename 
-     (lambda (out tmp-filename)
+                  (file-or-directory-modify-seconds filename))))))))
-       (s-exp->fasl providess out)))))
 
 (define (write-out/info latex-dest info scis providess db-file lock)
   (write-out latex-dest (info-vers info) (info-doc info) scis providess db-file lock))
@@ -1258,7 +1281,8 @@
                (doc-db-clear-dependencies db-file filename)
                (doc-db-clear-searches db-file filename)
                (doc-db-add-dependencies db-file undef filename)
-               (doc-db-add-searches db-file searches filename))))))
+               (doc-db-add-searches db-file searches filename))))
+          void))
 
 (define (write-in/info latex-dest info lock)
   (when (eq? 'delayed (info-undef info))

racket/lib/collects/setup/doc-db.rkt

@@ -7,6 +7,8 @@
 (provide doc-db-available?
          doc-db-clear-provides
          doc-db-add-provides
+         doc-db-set-provides-timestamp
+         doc-db-get-provides-timestamp
          doc-db-clear-dependencies
          doc-db-add-dependencies
          doc-db-clear-searches
@@ -135,6 +137,33 @@
          db-file filename
          "DELETE FROM documented WHERE pathid=$1"))
 
+(define (doc-db-set-provides-timestamp db-file filename seconds)
+  (call-with-database
+   'doc-db-set-provides-timestamp
+   db-file
+   #:write? #t
+   (lambda (db)
+     (prepare-tables db)
+     (define pathid (filename->pathid db filename))
+     (query-exec db "DELETE FROM timestamps WHERE pathid=$1"
+                 pathid)
+     (query-exec db "INSERT INTO timestamps VALUES ($1, $2)"
+                 pathid seconds))))
+
+(define (doc-db-get-provides-timestamp db-file filename)
+  (call-with-database
+   'doc-db-get-provides-timestamp
+   db-file
+   #:write? #t
+   (lambda (db)
+     (prepare-tables db)
+     (define pathid (filename->pathid db filename))
+     (define row
+       (query-maybe-row db (~a "SELECT seconds FROM timestamps"
+                               " WHERE pathid=$1")
+                        pathid))
+     (and row (vector-ref row 0)))))
+
 (define (doc-db-add-dependencies db-file depends filename)
   (add 'doc-db-add-dependencies
        db-file depends filename
@@ -355,6 +384,8 @@
          (define pathid (vector-ref row 2))
          (query-exec db "DELETE FROM documented WHERE pathid=$1"
                      pathid)
+         (query-exec db "DELETE FROM timestamps WHERE pathid=$1"
+                     pathid)
          (query-exec db "DELETE FROM searches WHERE pathid=$1"
                      pathid)
          (query-exec db "DELETE FROM searchSets WHERE pathid=$1"
@@ -441,7 +472,14 @@
     (query-exec db (~a "CREATE INDEX searchesTag "
                        "on searches (stag)"))
     (query-exec db (~a "CREATE INDEX searchesPathId "
-                       "on searches (pathid, setid)"))))
+                       "on searches (pathid, setid)")))
+  (when (null? 
+         (query-rows db (~a "SELECT name FROM sqlite_master"
+                            " WHERE type='table' AND name='timestamps'")))
+    (query-exec db (~a "CREATE TABLE timestamps "
+                       "(pathid SMALLINT,"
+                       " seconds BIGINT,"
+                       " PRIMARY KEY (pathid))"))))
 
 (define (exn:fail:retry? v)
   (and (exn:fail:sql? v)