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)
|
url-segments->guess-title)
|
||||||
|
|
||||||
(define (local-encoded-url->segments str) ; '("wiki" "Page_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 (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)))
|
(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
|
#lang typed/racket/base
|
||||||
(require racket/string
|
(require racket/string
|
||||||
|
typed/net/url-structs
|
||||||
"pure-utils.rkt")
|
"pure-utils.rkt")
|
||||||
(require/typed web-server/http/request-structs
|
(require/typed web-server/http/request-structs
|
||||||
[#:opaque Header header?])
|
[#:opaque Header header?])
|
||||||
|
@ -20,7 +21,10 @@
|
||||||
; pass in a header, headers, or something useless. they'll all combine into a list
|
; pass in a header, headers, or something useless. they'll all combine into a list
|
||||||
build-headers
|
build-headers
|
||||||
; try to follow wikimedia's format for which characters should be encoded/replaced in page titles for the url
|
; 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
|
(module+ test
|
||||||
(require "typed-rackunit.rkt"))
|
(require "typed-rackunit.rkt"))
|
||||||
|
@ -106,3 +110,20 @@
|
||||||
(: page-title->path (String -> Bytes))
|
(: page-title->path (String -> Bytes))
|
||||||
(define (page-title->path title)
|
(define (page-title->path title)
|
||||||
(percent-encode (regexp-replace* " " title "_") path-set #f))
|
(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))
|
(make-semicolon-fixer-dispatcher tree))
|
||||||
|
|
||||||
(define ((make-semicolon-fixer-dispatcher orig-dispatcher) conn orig-req)
|
(define ((make-semicolon-fixer-dispatcher orig-dispatcher) conn orig-req)
|
||||||
(define orig-uri (request-uri orig-req))
|
(define new-req (struct-copy request orig-req [uri (fix-semicolons-url (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]))
|
|
||||||
(orig-dispatcher conn new-req))
|
(orig-dispatcher conn new-req))
|
||||||
|
|
Loading…
Reference in a new issue