syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

append-url-path

This commit is contained in:
Tony Garnock-Jones 2016-11-22 11:08:11 +13:00
parent 6497cc5185
commit 0102a7d1cd
1 changed files with 18 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
racket/syndicate/drivers/web.rkt
View File

@ -31,6 +31,8 @@
web-respond/string!
web-respond/xexpr!
append-url-path
spawn-web-driver)
(define-logger syndicate/drivers/web)
@ -59,6 +61,8 @@
(require struct-defaults)
(require xml)
(module+ test (require rackunit))
(require/activate "timer.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -311,6 +315,20 @@
(list* path-element params)))
(foldr (lambda (e acc) (append e (list acc))) '() elements))
(define (append-url-path p1 p2)
(match p1
['() p2]
[(list "" '()) p2]
[(list pieces ... next) (append pieces (list (append-url-path next p2)))]))
(module+ test
(check-equal? (append-url-path '() '("c" ("d" ()))) '("c" ("d" ())))
(check-equal? (append-url-path '("" ()) '("c" ("d" ()))) '("c" ("d" ())))
(check-equal? (append-url-path '("a" "x" ("b" ())) '("c" ("d" ())))
'("a" "x" ("b" ("c" ("d" ())))))
(check-equal? (append-url-path '("a" "x" ("b" ("" ()))) '("c" ("d" ())))
'("a" "x" ("b" ("c" ("d" ()))))))
(define (build-headers hs)
(for/list ((h (in-list hs)))
(header (string->bytes/utf-8 (symbol->string (car h)))