forked from cadence/breezewiki
		
	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:
		
							parent
							
								
									cc138a07aa
								
							
						
					
					
						commit
						20a4043889
					
				
					 3 changed files with 56 additions and 27 deletions
				
			
		| 
						 | 
				
			
			@ -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))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										23
									
								
								dist.rkt
									
										
									
									
									
								
							
							
						
						
									
										23
									
								
								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)))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										36
									
								
								src/dispatcher-tree.rkt
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										36
									
								
								src/dispatcher-tree.rkt
									
										
									
									
									
										Normal 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))))
 | 
			
		||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue