(define-module(www url-coding)#:export(url-coding:decode url-coding:encode)#:use-module(ice-9 optargs)#:use-module((srfi srfi-4)#:select(make-u8vector u8vector-set!))#:use-module((srfi srfi-11)#:select(let*-values))#:use-module((srfi srfi-13)#:select(string-index string-skip string-concatenate-reverse substring/shared))#:use-module((srfi srfi-14)#:select(char-set char-set-intersection char-set-union char-set-difference list->char-set string->char-set char-set:ascii char-set:letter+digit)))
(define make-bv(cond-expand(guile-2 make-bitvector)(else(if(defined?  'make-bitvector)make-bitvector(lambda(sz init)(make-uniform-vector sz #t init))))))
(define bv-set!(cond-expand(guile-2 bitvector-set!)(else(if(defined?  'bitvector-set!)bitvector-set! uniform-vector-set!))))
(define bv-ref(cond-expand(guile-2 bitvector-ref)(else(if(defined?  'bitvector-ref)bitvector-ref uniform-vector-ref))))
(define PLUS/PERCENT(char-set #\+ #\%))
(define ZERO(char->integer #\0))
(define SPACE(char->integer #\space))
(define(particulars str)(let*((slen(string-length str))(hmmm(make-bv slen #f))(plus(make-bv slen #f)))(define(yep! bv pos)(bv-set! bv pos #t))(let scan((len(string-length str))(start 0))(cond((string-index str PLUS/PERCENT start)=>(lambda(pos)(yep! hmmm pos)(let((dec(char=? #\%(string-ref str pos))))(or dec(yep! plus pos))(scan(if dec(- len 2)len)(+ pos(if dec 3 1))))))(else(values hmmm plus slen len))))))
(define(c-hex c)(case c((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)(-(char->integer c)ZERO))((#\a #\A)10)((#\b #\B)11)((#\c #\C)12)((#\d #\D)13)((#\e #\E)14)((#\f #\F)15)))
(define*(url-coding:decode str #:optional(u8 #f))(define(w/string len)(let((s(make-string len))(wx 0))(define(one! n)(string-set! s wx(integer->char n))(set! wx(#{1+}# wx)))(define(many! beg end)(substring-move! str beg end s wx)(set! wx(+ wx(- end beg))))(values s one! many!)))(define(w/u8vector len)(let((v(make-u8vector len))(wx 0))(define(one! n)(u8vector-set! v wx n)(set! wx(#{1+}# wx)))(define(many! beg end)(do((i beg(#{1+}# i)))((= end i))(one!(char->integer(string-ref str i)))))(values v one! many!)))(let*-values(((hmmm plus slen len)(particulars str))((rv one! many!)((if u8 w/u8vector w/string)len)))(let transfer((rx 0))(define(copy-up-to! end)(many! rx end))(cond((bit-position #t hmmm rx)=>(lambda(pos)(define(n-at ofs)(c-hex(string-ref str(+ ofs pos))))(copy-up-to! pos)(transfer(+ pos(cond((bv-ref plus pos)(one! SPACE)1)(else(one!(logior(ash(n-at 1)4)(n-at 2)))3))))))(else(copy-up-to! slen)rv)))))
(define url-coding:encode(let((safe(char-set-union(char-set-intersection char-set:letter+digit char-set:ascii)(string->char-set "$-_.+!*'(),")(string->char-set ";/?:@&="))))(define percent(let((v(list->vector(map(lambda(i)(string-append "%"(if(> 16 i)"0" "")(number->string i 16)))(iota 256)))))(lambda(ch)(vector-ref v(char->integer ch)))))(lambda(str reserved-chars)(let((ok(if(pair? reserved-chars)(char-set-difference safe(list->char-set reserved-chars))safe)))(let loop((acc '())(start 0))(define (until . end)(apply substring/shared str start end))(cond((string-skip str ok start)=>(lambda(pos)(loop(cons*(percent(string-ref str pos))(until pos)acc)(#{1+}# pos))))(else(string-concatenate-reverse acc(until)))))))))
