forked from cadence/breezewiki
		
	Move the semicolon fixing code again
This commit is contained in:
		
							parent
							
								
									ca13aea547
								
							
						
					
					
						commit
						6fef9281c3
					
				
					 3 changed files with 24 additions and 14 deletions
				
			
		| 
						 | 
				
			
			@ -11,7 +11,7 @@
 | 
			
		|||
 url-segments->guess-title)
 | 
			
		||||
 | 
			
		||||
(define (local-encoded-url->segments str) ; '("wiki" "Page_title")
 | 
			
		||||
  (map path/param-path (url-path (string->url str))))
 | 
			
		||||
  (map path/param-path (fix-semicolons-url-path (url-path (string->url str)))))
 | 
			
		||||
 | 
			
		||||
(define (url-segments->basename segments) ; "Page_title" filename encoded, no extension or dir prefix
 | 
			
		||||
  (define extra-encoded (map (λ (s) (bytes->string/latin-1 (percent-encode s filename-set #f))) (cdr segments)))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,5 +1,6 @@
 | 
			
		|||
#lang typed/racket/base
 | 
			
		||||
(require racket/string
 | 
			
		||||
         typed/net/url-structs
 | 
			
		||||
         "pure-utils.rkt")
 | 
			
		||||
(require/typed web-server/http/request-structs
 | 
			
		||||
               [#:opaque Header header?])
 | 
			
		||||
| 
						 | 
				
			
			@ -20,7 +21,10 @@
 | 
			
		|||
 ; pass in a header, headers, or something useless. they'll all combine into a list
 | 
			
		||||
 build-headers
 | 
			
		||||
 ; try to follow wikimedia's format for which characters should be encoded/replaced in page titles for the url
 | 
			
		||||
 page-title->path)
 | 
			
		||||
 page-title->path
 | 
			
		||||
 ; path/param eats semicolons into params, which need to be fixed back into semicolons
 | 
			
		||||
 fix-semicolons-url-path
 | 
			
		||||
 fix-semicolons-url)
 | 
			
		||||
 | 
			
		||||
(module+ test
 | 
			
		||||
  (require "typed-rackunit.rkt"))
 | 
			
		||||
| 
						 | 
				
			
			@ -106,3 +110,20 @@
 | 
			
		|||
(: page-title->path (String -> Bytes))
 | 
			
		||||
(define (page-title->path title)
 | 
			
		||||
  (percent-encode (regexp-replace* " " title "_") path-set #f))
 | 
			
		||||
 | 
			
		||||
(: fix-semicolons-url-path ((Listof Path/Param) -> (Listof Path/Param)))
 | 
			
		||||
(define (fix-semicolons-url-path pps)
 | 
			
		||||
  (for/list ([pp pps])
 | 
			
		||||
    (define path (path/param-path pp))
 | 
			
		||||
    (if (or (null? (path/param-param pp))
 | 
			
		||||
            (symbol? path))
 | 
			
		||||
        pp
 | 
			
		||||
        ;; path/param does have params, which need to be fixed into a semicolon.
 | 
			
		||||
        (path/param
 | 
			
		||||
         (string-append path ";" (string-join (path/param-param pp) ";"))
 | 
			
		||||
         null))))
 | 
			
		||||
 | 
			
		||||
(: fix-semicolons-url (URL -> URL))
 | 
			
		||||
(define (fix-semicolons-url orig-url)
 | 
			
		||||
  (struct-copy url orig-url [path (fix-semicolons-url-path (url-path orig-url))]))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -59,16 +59,5 @@
 | 
			
		|||
  (make-semicolon-fixer-dispatcher tree))
 | 
			
		||||
 | 
			
		||||
(define ((make-semicolon-fixer-dispatcher orig-dispatcher) conn orig-req)
 | 
			
		||||
  (define orig-uri (request-uri orig-req))
 | 
			
		||||
  (define pps (url-path orig-uri)) ; list of path/param structs
 | 
			
		||||
  (define new-path
 | 
			
		||||
    (for/list ([pp pps])
 | 
			
		||||
      (if (null? (path/param-param pp))
 | 
			
		||||
          pp
 | 
			
		||||
          ;; path/param does have params, which need to be fixed into a semicolon.
 | 
			
		||||
          (path/param
 | 
			
		||||
           (string-append (path/param-path pp) ";" (string-join (path/param-param pp) ";"))
 | 
			
		||||
           null))))
 | 
			
		||||
  (define new-uri (struct-copy url orig-uri [path new-path]))
 | 
			
		||||
  (define new-req (struct-copy request orig-req [uri new-uri]))
 | 
			
		||||
  (define new-req (struct-copy request orig-req [uri (fix-semicolons-url (request-uri orig-req))]))
 | 
			
		||||
  (orig-dispatcher conn new-req))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue