Abstract out code-reloading support

README.md

@@ -1,5 +1,11 @@
 # Racket Package Library Website
 
+## Prerequisites
+
+You will need to install the following Racket packages:
+
+    raco pkg install reloadable
+
 ## Local testing
 
 You will need some dummy SSL keys. Run `make keys` to produce some.

src/entrypoint.rkt

@@ -1,13 +1,13 @@
 #lang racket/base
 
-(provide (struct-out entry-point) ;; from reload.rkt
-         make-entry-point ;; from reload.rkt
+(provide (struct-out reloadable-entry-point) ;; from reloadable
+         make-reloadable-entry-point ;; from reloadable
          start-service)
 
 (require web-server/servlet-env)
 (require web-server/managers/lru)
+(require reloadable)
 (require "signals.rkt")
-(require "reload.rkt")
 
 (define (start-service* #:port [port 8443]
                         #:ssl? [ssl? #t]
@@ -40,5 +40,5 @@
   (reload!)
   (start-service* #:port port
                   #:ssl? ssl?
-                  (lambda (req) ((entry-point-value request-handler-entry-point) req))
-                  (lambda (req) ((entry-point-value on-continuation-expiry-entry-point) req))))
+                  (reloadable-entry-point->procedure request-handler-entry-point)
+                  (reloadable-entry-point->procedure on-continuation-expiry-entry-point)))

src/main.rkt

@@ -2,8 +2,10 @@
 
 (module+ main
   (require "entrypoint.rkt")
-  (void (make-entry-point 'refresh-packages! "packages.rkt"))
-  (void (make-entry-point 'rerender-all! "site.rkt"))
+  (void (make-reloadable-entry-point 'refresh-packages! "packages.rkt"))
+  (void (make-reloadable-entry-point 'rerender-all! "site.rkt"))
   (start-service #:reloadable? (getenv "SITE_RELOADABLE")
-                 (make-entry-point 'request-handler "site.rkt")
-                 (make-entry-point 'on-continuation-expiry "site.rkt")))
+                 #:port (let ((port-str (getenv "SITE_PORT")))
+                          (if port-str (string->number port-str) 8443))
+                 (make-reloadable-entry-point 'request-handler "site.rkt")
+                 (make-reloadable-entry-point 'on-continuation-expiry "site.rkt")))

src/packages.rkt

@@ -24,7 +24,7 @@
 (require racket/list)
 (require web-server/private/gzip)
 (require net/url)
-(require "reload.rkt")
+(require reloadable)
 (require "daemon.rkt")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

src/reload.rkt

@@ -1,85 +0,0 @@
-#lang racket/base
-
-(provide (struct-out entry-point)
-         reload-poll-interval
-         set-reload-poll-interval!
-         reload-failure-retry-delay
-         reload!
-         make-entry-point
-         lookup-entry-point
-         make-persistent-state)
-
-(require racket/match)
-(require racket/rerequire)
-(require (only-in web-server/private/util exn->string))
-
-(define reload-poll-interval 0.5) ;; seconds
-(define reload-failure-retry-delay (make-parameter 5)) ;; seconds
-
-(struct entry-point (name module-path identifier-symbol [value #:mutable]) #:prefab)
-
-(define entry-points (make-hash))
-(define persistent-state (make-hash))
-
-(define (set-reload-poll-interval! v)
-  (set! reload-poll-interval v))
-
-(define (reloader-main)
-  (let loop ()
-    (match (sync (handle-evt (thread-receive-evt)
-                             (lambda (_) (thread-receive)))
-                 (if reload-poll-interval
-                     (handle-evt (alarm-evt (+ (current-inexact-milliseconds)
-                                               (* reload-poll-interval 1000)))
-                                 (lambda (_) (list #f 'reload)))
-                     never-evt))
-      [(list ch 'reload)
-       (define result (do-reload!))
-       (when (not result) (sleep (reload-failure-retry-delay)))
-       (when ch (channel-put ch result))])
-    (loop)))
-
-(define reloader-thread (thread reloader-main))
-
-(define (reloader-rpc . request)
-  (define ch (make-channel))
-  (thread-send reloader-thread (cons ch request))
-  (channel-get ch))
-
-(define (reload!) (reloader-rpc 'reload))
-
-;; Only to be called from reloader-main
-(define (do-reload!)
-  (with-handlers ((exn:fail?
-                   (lambda (e)
-                     (log-error "*** WHILE RELOADING CODE***\n~a" (exn->string e))
-                     #f)))
-    (for ((e (in-hash-values entry-points)))
-      (match-define (entry-point _ module-path identifier-symbol _) e)
-      (dynamic-rerequire module-path #:verbosity 'all)
-      (set-entry-point-value! e (dynamic-require module-path identifier-symbol)))
-    #t))
-
-(define (make-entry-point name module-path [identifier-symbol name])
-  (when (hash-has-key? entry-points name)
-    (error 'make-entry-point "Duplicate entry-point name ~a" name))
-  (define e (entry-point name module-path identifier-symbol #f))
-  (hash-set! entry-points name e)
-  e)
-
-(define (lookup-entry-point name)
-  (hash-ref entry-points name))
-
-(define (make-persistent-state name initial-value-thunk)
-  (hash-ref persistent-state
-            name
-            (lambda ()
-              (define value (initial-value-thunk))
-              (define handler
-                (case-lambda
-                  [() value]
-                  [(new-value)
-                   (set! value new-value)
-                   value]))
-              (hash-set! persistent-state name handler)
-              handler)))

src/sessions.rkt

@@ -10,7 +10,7 @@
          lookup-session)
 
 (require "randomness.rkt")
-(require "reload.rkt")
+(require reloadable)
 
 (define current-session (make-parameter #f))
 (define session-lifetime (make-parameter (* 7 24 60 60 1000))) ;; one week in milliseconds

src/signals.rkt

@@ -4,7 +4,7 @@
 (provide poll-signal
 	 start-restart-signal-watcher)
 
-(require "reload.rkt")
+(require reloadable)
 
 (define (poll-signal signal-file-name message handler)
   (when (file-exists? signal-file-name)
@@ -28,12 +28,14 @@
 		    (lambda () (exit 0)))
        (poll-signal "../signals/.reload"
                     "Reload signal received - attempting to reload code"
-                    (lambda () (reload!)))
+                    reload!)
        (poll-signal "../signals/.fetchindex"
                     "Index refresh signal received"
-                    (lambda () ((entry-point-value (lookup-entry-point 'refresh-packages!)))))
+                    (reloadable-entry-point->procedure
+                     (lookup-reloadable-entry-point 'refresh-packages!)))
        (poll-signal "../signals/.rerender"
                     "Static rerender request received"
-                    (lambda () ((entry-point-value (lookup-entry-point 'rerender-all!)))))
+                    (reloadable-entry-point->procedure
+                     (lookup-reloadable-entry-point 'rerender-all!)))
        (sleep 0.5)
        (loop)))))

src/site.rkt

@@ -18,7 +18,7 @@
 (require "packages.rkt")
 (require "sessions.rkt")
 (require "jsonp-client.rkt")
-(require "reload.rkt")
+(require reloadable)
 (require "daemon.rkt")
 
 (define static-cached-directory "../static/cached")