From 2d55b78b8309d8c609dde0202011bbf06528f75b Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Thu, 4 Dec 2014 12:21:02 -0500
Subject: [PATCH] Make package-change-handler properly reloadable and avoid
 leak of processes (!)

---
 src/packages.rkt |  3 ++-
 src/site.rkt     | 58 +++++++++++++++++++++++++++++-------------------
 2 files changed, 37 insertions(+), 24 deletions(-)

diff --git a/src/packages.rkt b/src/packages.rkt
index 9587af6..2d93304 100644
--- a/src/packages.rkt
+++ b/src/packages.rkt
@@ -234,7 +234,8 @@
     (if (not (package-change-handler-thread))
         (begin (sleep 0.5)
                (retry))
-        (thread-send (package-change-handler-thread) (list completion-ch package-name)))))
+        (thread-send (package-change-handler-thread)
+                     (list 'package-changed completion-ch package-name)))))
 
 (define (manager-rpc . request)
   (define ch (make-channel))
diff --git a/src/site.rkt b/src/site.rkt
index 3f44005..cda4375 100644
--- a/src/site.rkt
+++ b/src/site.rkt
@@ -1259,28 +1259,40 @@
   (set-package-external-information! package-name external-information))
 
 (define (rerender-all!)
-  (for ((p (all-package-names)))
-    (update-external-package-information! p)
-    (static-render! package-page (symbol->string p)))
-  (static-render! main-page))
+  (thread-send (package-change-handler-thread) 'rerender-all!))
 
-(define (package-change-handler)
-  (let loop ((index-rerender-needed? #f)
-             (pending-completions '()))
-    (sync/timeout (and index-rerender-needed?
-                       (lambda ()
-                         (static-render! main-page)
-                         (for ((completion-ch pending-completions))
-                           (channel-put completion-ch (void)))
-                         (loop #f '())))
-                  (handle-evt (thread-receive-evt)
-                              (lambda (_)
-                                (match (thread-receive)
-                                  [(list completion-ch package-name)
-                                   (update-external-package-information! package-name)
-                                   (static-render! package-page (symbol->string package-name))
-                                   (loop #t (if completion-ch
-                                                (cons completion-ch pending-completions)
-                                                pending-completions))]))))))
+(define (package-change-handler index-rerender-needed? pending-completions)
+  (sync/timeout (and index-rerender-needed?
+                     (lambda ()
+                       (static-render! main-page)
+                       (for ((completion-ch pending-completions))
+                         (channel-put completion-ch (void)))
+                       (package-change-handler #f '())))
+                (handle-evt (thread-receive-evt)
+                            (lambda (_)
+                              (match (thread-receive)
+                                ['upgrade
+                                 (package-change-handler index-rerender-needed?
+                                                         pending-completions)]
+                                ['rerender-all!
+                                 (log-info "rerender-all!")
+                                 (for ((p (all-package-names)))
+                                   (update-external-package-information! p)
+                                   (static-render! package-page (symbol->string p)))
+                                 (static-render! main-page)
+                                 (package-change-handler index-rerender-needed?
+                                                         pending-completions)]
+                                [(list 'package-changed completion-ch package-name)
+                                 (update-external-package-information! package-name)
+                                 (static-render! package-page (symbol->string package-name))
+                                 (package-change-handler
+                                  #t
+                                  (if completion-ch
+                                      (cons completion-ch pending-completions)
+                                      pending-completions))])))))
 
-(package-change-handler-thread (daemon-thread 'package-change-handler package-change-handler))
+(when (not (package-change-handler-thread))
+  (package-change-handler-thread (daemon-thread 'package-change-handler
+                                                (lambda () (package-change-handler #f '())))))
+
+(thread-send (package-change-handler-thread) 'upgrade) ;; switch to new code