diff --git a/breezewiki.rkt b/breezewiki.rkt index 0421e12..ac60e1f 100644 --- a/breezewiki.rkt +++ b/breezewiki.rkt @@ -1,10 +1,7 @@ #lang racket/base (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/dispatcher-tree.rkt" "src/reloadable.rkt") (define-syntax-rule (require-reloadable filename varname) @@ -20,8 +17,6 @@ (require-reloadable "src/page-static.rkt" static-dispatcher) (require-reloadable "src/page-wiki.rkt" page-wiki) -(when (not (config-true? 'debug)) - (set-reload-poll-interval! #f)) (reload!) (define ch (make-channel)) @@ -31,13 +26,14 @@ #:port (string->number (config-get 'port)) (λ (quit) (channel-put ch (lambda () (semaphore-post quit))) - (sequencer:make - (pathprocedure:make "/" page-home) - (pathprocedure:make "/proxy" page-proxy) - (filter:make #rx"^/[a-z-]+/wiki/Category:.+$" (lift:make page-category)) - (filter:make #rx"^/[a-z-]+/wiki/.+$" (lift:make page-wiki)) - (filter:make #rx"^/[a-z-]+/search$" (lift:make page-search)) - static-dispatcher - (lift:make page-not-found))))) + (dispatcher-tree + ; order of these does not matter + page-category + page-home + page-not-found + page-proxy + page-search + page-wiki + static-dispatcher)))) (define server-t (thread start)) (define quit (channel-get ch)) diff --git a/dist.rkt b/dist.rkt index 9e190ef..289f9bd 100644 --- a/dist.rkt +++ b/dist.rkt @@ -1,11 +1,7 @@ #lang racket/base (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/reloadable.rkt") + "src/dispatcher-tree.rkt") (require (only-in "src/page-category.rkt" page-category)) (require (only-in "src/page-home.rkt" page-home)) @@ -19,11 +15,12 @@ #:listen-ip (if (config-true? 'debug) "127.0.0.1" #f) #:port (string->number (config-get 'port)) (λ (quit) - (sequencer:make - (pathprocedure:make "/" page-home) - (pathprocedure:make "/proxy" page-proxy) - (filter:make #rx"^/[a-z-]+/wiki/Category:.+$" (lift:make page-category)) - (filter:make #rx"^/[a-z-]+/wiki/.+$" (lift:make page-wiki)) - (filter:make #rx"^/[a-z-]+/search$" (lift:make page-search)) - static-dispatcher - (lift:make page-not-found)))) + (dispatcher-tree + ; order of these does not matter + page-category + page-home + page-not-found + page-proxy + page-search + page-wiki + static-dispatcher))) diff --git a/src/dispatcher-tree.rkt b/src/dispatcher-tree.rkt new file mode 100644 index 0000000..626ee09 --- /dev/null +++ b/src/dispatcher-tree.rkt @@ -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))))