simplify server

server-routes.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
-(require racket/list racket/contract racket/rerequire racket/file racket/format xml racket/match racket/set)
+(require racket/list racket/contract racket/rerequire racket/file racket/format xml racket/match racket/set racket/string)
-(require web-server/http/xexpr)
+(require web-server/http/xexpr web-server/dispatchers/dispatch)
 (require (only-in net/url url-query url->path url->string))
 (require (only-in web-server/http/request-structs request-uri request-client-ip request?))
 (require (only-in web-server/http/response-structs response?))
@@ -12,7 +12,21 @@
 ;;; separated out for ease of testing
 ;;; because it's tedious to start the server just to check a route.
 
-(provide (all-defined-out))
+(provide route-dashboard route-raw route-xexpr route-default route-404)
+
+(define (logger req)
+  (define client (request-client-ip req))
+  (define url-string (url->string (request-uri req)))
+  (message "Request:" (string-replace url-string DASHBOARD_NAME " dashboard")
+           "from" (if (equal? client "::1") "localhost" client)))
+
+(define/contract (route-wrapper route-proc)
+  (procedure? . -> . procedure?)
+  (λ(req . string-args) 
+    (logger req) 
+    (define path (apply build-path PROJECT_ROOT (flatten string-args)))
+    (response/xexpr (route-proc path))))
+
 
 ;; extract main xexpr from a path
 (define/contract (file->xexpr path #:render [wants-render #t])
@@ -57,19 +71,17 @@
 
 ;; server route that returns raw html, formatted as code
 ;; for viewing source without using "view source"
-(define/contract (route-raw path)
+(define/contract (raw path)
   (complete-path? . -> . xexpr?)
   (format-as-code (slurp path #:render #f)))
 
 ;; server route that returns xexpr (before conversion to html)
-(define/contract (route-xexpr path)
+(define/contract (xexpr path)
   (complete-path? . -> . xexpr?)
   (format-as-code (~v (file->xexpr path))))
 
 
-
+(define (dashboard dir)
-
-(define (route-dashboard dir)
   (define empty-cell (cons #f #f))
   (define (make-link-cell href+text)
     (match-define (cons href text) href+text) 
@@ -133,9 +145,12 @@
 
 ; default route
 (define (route-default req)  
+  (logger req)
   (define force (equal? (get-query-value (request-uri req) 'force) "true"))
   (with-handlers ([exn:fail? (λ(e) (message "Render is skipping" (url->string (request-uri req)) "because of error\n" (exn-message e)))])
-    (render (req->path req) #:force force)))
+    (render (req->path req) #:force force))
+  (next-dispatcher))
+
 
 
 ; error route
@@ -146,5 +161,10 @@
   ;`(html ,(slurp (build-path SERVER_EXTRAS_DIR "404.html")))
   (response/xexpr `(html ,error-text)))
 
+
+(define route-dashboard (route-wrapper dashboard))
+(define route-raw (route-wrapper raw))
+(define route-xexpr (route-wrapper xexpr))
+
 (module+ main
-  (route-dashboard "foobar"))
+  )

server.rkt

@@ -1,51 +1,30 @@
 #lang web-server
-(require "startup.rkt")
+(require web-server/servlet-env 
-(require web-server/servlet-env web-server/dispatch web-server/dispatchers/dispatch web-server/configuration/responders xml)
+         web-server/dispatch)
-(require "server-routes.rkt" "debug.rkt" "world.rkt")
+(require "server-routes.rkt" 
+         "debug.rkt" 
+         "world.rkt")
 
-(define port-number 8088)
+(define-values (pollen-servlet url)
-
-(message (format "Project root is ~a" PROJECT_ROOT))
-(message (format "Project server is http://localhost:~a" port-number) "(Ctrl-C to exit)")
-
-(define (logger req)
-  (define client (request-client-ip req))
-  (define url-string (url->string (request-uri req)))
-  (message "Request:" (string-replace url-string DASHBOARD_NAME " dashboard")
-           "from" (if (equal? client "::1") "localhost" client)))
-
-(define/contract (route-wrapper route-proc)
-  (procedure? . -> . procedure?)
-  (λ(req . string-args) 
-    (logger req) 
-    (define path (apply build-path PROJECT_ROOT (flatten string-args)))
-    (response/xexpr (route-proc path))))
-
-(define-values (start url)
   (dispatch-rules
-   ;; the match patterns for each rule represent /each/slashed/piece of a url
-   ;; (as if the url is split on slashes into a list before matching)
-   ;; dashboard page: works on any url of form /dir/dir/dir/poldash.html
    ;; todo: figure out how to use world:DASHBOARD_NAME here
-   [((string-arg) ... "poldash.html") (route-wrapper route-dashboard)]
+   [((string-arg) ... "poldash.html") route-dashboard]
-   ;; raw viewer: works on any url of form /dir/dir/raw/name.html 
+   [((string-arg) ... "raw" (string-arg)) route-raw]
-   ;; (pattern matcher automatically takes out the "raw")
+   [((string-arg) ... "xexpr" (string-arg)) route-xexpr]
-   [((string-arg) ... "raw" (string-arg)) (route-wrapper route-raw)]
+   ;;  [((string-arg) ... "force" (string-arg)) (route-wrapper route-force)]
-   [((string-arg) ... "xexpr" (string-arg)) (route-wrapper route-xexpr)]
+   [else route-default]))
-   ;  [((string-arg) ... "force" (string-arg)) (route-wrapper route-force)]
-   [else  (λ(req)
-            ;; because it's the "else" route, can't use string-arg matcher
-            (logger req)
-            (route-default req)
-            (next-dispatcher))]))
 
-(message (format "Project dashboard is http://localhost:~a/pollen.html" port-number))
+(message (format "Welcome to Pollen ~a" POLLEN_VERSION) (format "(Racket ~a)" (version)))
-(message "Ready to rock")
+(message (format "Project root is ~a" PROJECT_ROOT))
 
+(define server-name (format "http://localhost:~a" SERVER_PORT))
+(message (format "Project server is ~a" server-name) "(Ctrl-C to exit)")
+(message (format "Project dashboard is ~a/pollen.html" server-name))
 
+(message "Ready to rock")
 
-(serve/servlet start
+(serve/servlet pollen-servlet
-               #:port port-number
+               #:port SERVER_PORT
                #:listen-ip #f
                #:servlet-regexp #rx"" ; respond to top level
                #:command-line? #t

startup.rkt

@@ -1,3 +0,0 @@
-#lang racket/base
-(require "debug.rkt" "world.rkt")
-(message (format "Welcome to Pollen ~a" POLLEN_VERSION) (format "(Racket ~a)" (version)))

world.rkt

@@ -51,4 +51,6 @@
 (define MODULE_ROOT (apply build-path (drop-right (explode-path (current-contract-region)) 1)))
 (define SERVER_EXTRAS_DIR (build-path MODULE_ROOT "pollen-server-extras"))
 
+(define SERVER_PORT 8088)
+
 (define DASHBOARD_NAME "poldash.html")