Simplify files even more

- breezewiki.rkt now always sets up the hot-reload watcher
- dispatcher logic moved to dispatcher-tree.rkt
- dispatcher-tree is a macro that doesn't care about the order of its forms
This commit is contained in:
Cadence Ember 2022-09-04 22:13:36 +12:00
parent cc138a07aa
commit 20a4043889
Signed by untrusted user: cadence
GPG key ID: BC1C2C61CF521B17
3 changed files with 56 additions and 27 deletions

View file

@ -1,10 +1,7 @@
#lang racket/base #lang racket/base
(require web-server/servlet-dispatch (require web-server/servlet-dispatch
(prefix-in pathprocedure: web-server/dispatchers/dispatch-pathprocedure)
(prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
(prefix-in lift: web-server/dispatchers/dispatch-lift)
(prefix-in filter: web-server/dispatchers/dispatch-filter)
"src/config.rkt" "src/config.rkt"
"src/dispatcher-tree.rkt"
"src/reloadable.rkt") "src/reloadable.rkt")
(define-syntax-rule (require-reloadable filename varname) (define-syntax-rule (require-reloadable filename varname)
@ -20,8 +17,6 @@
(require-reloadable "src/page-static.rkt" static-dispatcher) (require-reloadable "src/page-static.rkt" static-dispatcher)
(require-reloadable "src/page-wiki.rkt" page-wiki) (require-reloadable "src/page-wiki.rkt" page-wiki)
(when (not (config-true? 'debug))
(set-reload-poll-interval! #f))
(reload!) (reload!)
(define ch (make-channel)) (define ch (make-channel))
@ -31,13 +26,14 @@
#:port (string->number (config-get 'port)) #:port (string->number (config-get 'port))
(λ (quit) (λ (quit)
(channel-put ch (lambda () (semaphore-post quit))) (channel-put ch (lambda () (semaphore-post quit)))
(sequencer:make (dispatcher-tree
(pathprocedure:make "/" page-home) ; order of these does not matter
(pathprocedure:make "/proxy" page-proxy) page-category
(filter:make #rx"^/[a-z-]+/wiki/Category:.+$" (lift:make page-category)) page-home
(filter:make #rx"^/[a-z-]+/wiki/.+$" (lift:make page-wiki)) page-not-found
(filter:make #rx"^/[a-z-]+/search$" (lift:make page-search)) page-proxy
static-dispatcher page-search
(lift:make page-not-found))))) page-wiki
static-dispatcher))))
(define server-t (thread start)) (define server-t (thread start))
(define quit (channel-get ch)) (define quit (channel-get ch))

View file

@ -1,11 +1,7 @@
#lang racket/base #lang racket/base
(require web-server/servlet-dispatch (require web-server/servlet-dispatch
(prefix-in pathprocedure: web-server/dispatchers/dispatch-pathprocedure)
(prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
(prefix-in lift: web-server/dispatchers/dispatch-lift)
(prefix-in filter: web-server/dispatchers/dispatch-filter)
"src/config.rkt" "src/config.rkt"
"src/reloadable.rkt") "src/dispatcher-tree.rkt")
(require (only-in "src/page-category.rkt" page-category)) (require (only-in "src/page-category.rkt" page-category))
(require (only-in "src/page-home.rkt" page-home)) (require (only-in "src/page-home.rkt" page-home))
@ -19,11 +15,12 @@
#:listen-ip (if (config-true? 'debug) "127.0.0.1" #f) #:listen-ip (if (config-true? 'debug) "127.0.0.1" #f)
#:port (string->number (config-get 'port)) #:port (string->number (config-get 'port))
(λ (quit) (λ (quit)
(sequencer:make (dispatcher-tree
(pathprocedure:make "/" page-home) ; order of these does not matter
(pathprocedure:make "/proxy" page-proxy) page-category
(filter:make #rx"^/[a-z-]+/wiki/Category:.+$" (lift:make page-category)) page-home
(filter:make #rx"^/[a-z-]+/wiki/.+$" (lift:make page-wiki)) page-not-found
(filter:make #rx"^/[a-z-]+/search$" (lift:make page-search)) page-proxy
static-dispatcher page-search
(lift:make page-not-found)))) page-wiki
static-dispatcher)))

36
src/dispatcher-tree.rkt Normal file
View file

@ -0,0 +1,36 @@
#lang racket/base
(require (for-syntax racket/base)
(prefix-in pathprocedure: web-server/dispatchers/dispatch-pathprocedure)
(prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
(prefix-in lift: web-server/dispatchers/dispatch-lift)
(prefix-in filter: web-server/dispatchers/dispatch-filter))
(provide
; syntax to make the hashmap from names
dispatcher-tree
; procedure to make the tree from the hashmap
make-dispatcher-tree)
; make a hashmap out of the provided names and call make-dispatcher-tree with it
(define-syntax (dispatcher-tree stx)
; the arguments, which are names of dispatcher variables
(define names (cdr (syntax->list stx)))
; map each name to syntax of a '(name . ,name)
(define alist (map (λ (xe) ; xe is the syntax of a name
; return instead syntax of a cons cell
(datum->syntax stx `(cons ',xe ,xe)))
names))
; make syntax to make the hash
(define ds (datum->syntax stx `(make-hasheq (list ,@alist))))
; don't forget that I'm returning *code* - return a call to the function
(datum->syntax stx `(make-dispatcher-tree ,ds)))
(define (make-dispatcher-tree ds)
(sequencer:make
(pathprocedure:make "/" (hash-ref ds 'page-home))
(pathprocedure:make "/proxy" (hash-ref ds 'page-proxy))
(filter:make #rx"^/[a-z-]+/wiki/Category:.+$" (lift:make (hash-ref ds 'page-category)))
(filter:make #rx"^/[a-z-]+/wiki/.+$" (lift:make (hash-ref ds 'page-wiki)))
(filter:make #rx"^/[a-z-]+/search$" (lift:make (hash-ref ds 'page-search)))
(hash-ref ds 'static-dispatcher)
(lift:make (hash-ref ds 'page-not-found))))