(define-module(www url)#:export(url:scheme url:address url:unknown url:user url:host url:port url:path url:make url:make-http url:make-ftp url:make-mailto url:parse url:unparse url:decode url:encode)#:use-module(www url-coding)#:use-module((srfi srfi-13)#:select(substring/shared string-index string-take string-prefix?))#:use-module((ice-9 regex)#:select(match:substring match:start)))
(define(url:scheme url)(vector-ref url 0))
(define(url:address url)(or(eq?  'mailto(url:scheme url))(error "invalid url scheme:"(url:scheme url)))(vector-ref url 1))
(define(url:unknown url)(or(eq?  'unknown(url:scheme url))(error "invalid url scheme:"(url:scheme url)))(vector-ref url 1))
(define(url:user url)(vector-ref url 1))
(define(url:host url)(vector-ref url 2))
(define(url:port url)(vector-ref url 3))
(define(url:path url)(vector-ref url 4))
(define (url:make scheme . args)(apply vector scheme args))
(define(url:make-http host port path)(vector  'http #f host port path))
(define(url:make-ftp user host port path)(vector  'ftp user host port path))
(define(url:make-mailto address)(vector  'mailto address))
(define parse-http(let((port-rx(make-regexp ":[0-9]+$")))(lambda(string)(define(maybe pred)(string-index string pred))(define(after pos)(substring/shared string(#{1+}# pos)))(define(before pos)(string-take string pos))(let((user #f)(host #f)(port #f)(path #f))(cond((maybe #\/)=>(lambda(pos)(set! path(after pos))(set! string(before pos)))))(cond((maybe #\@)=>(lambda(pos)(set! user(before pos))(set! string(after pos)))))(cond((regexp-exec port-rx string)=>(lambda(m)(let((pos(match:start m)))(set! port(string->number(after pos)))(set! string(before pos))))))(or(string-null? string)(set! host string))(url:make  'http user host port path)))))
(define parse-ftp(let((rx(make-regexp "^(([^@:/]+)@)?([^:/]+)(:([0-9]+))?(/(.*))?$")))(lambda(string)(let((m(regexp-exec rx string)))(url:make-ftp(match:substring m 2)(match:substring m 3)(cond((match:substring m 5)=> string->number)(else #f))(match:substring m 7))))))
(define(url:parse string)(define(try prefix ok)(and(string-prefix? prefix string)(ok(substring/shared string(string-length prefix)))))(or(try "http://" parse-http)(try "ftp://" parse-ftp)(try "mailto:" url:make-mailto)(url:make  'unknown string)))
(define(url:unparse url)(define (fs s . args)(apply simple-format #f s args))(define(pathy scheme username url)(fs "~A://~A~A~A" scheme(url:host url)(cond((url:port url)=>(lambda(port)(fs ":~A" port)))(else ""))(cond((url:path url)=>(lambda(path)(fs "/~A" path)))(else ""))))(case(url:scheme url)((http)(pathy  'http #f url))((ftp)(pathy  'ftp(url:user url)url))((mailto)(fs "mailto:~A"(url:address url)))((unknown)(url:unknown url))))
(define(url:decode str)(url-coding:decode str))
(define(url:encode str reserved-chars)(url-coding:encode str reserved-chars))
