#lang scheme

(define (split-once string sep)
  (let ([match
            (regexp-match (regexp (string-append "([^" sep "]*)" sep "(.*)")) string)])
    (if match (values (car match) (cadr match))
        (values #f string))))

(define decode-apq #f)

(define schemes
  (make-immutable-hash
   `(http ,(decode-apq 'http))
   `(ftp ,(decode-apq 'ftp))))

(define (decode-uri string)
  (let-values ([(scheme rest) (split-once string ":")])
    (if scheme
        (list* scheme ((hash-ref schemes (string->symbol scheme)) rest))
        (list* 'relative (regexp-split #rx"/" rest)))))

(define URI%
  (class object%
    (init-field scheme user host port path/params query fragment)
    (field
     [args (make-immutable-hash query)])
    
    (define/public (path-components)
      (map (λ (pp) (path/param-path pp)) path/params))
    (define/public (extract-path)
      (string-append "/" (string-join (path-components) "/")))
    (define/public (arg-get name)
      (hash-ref args name))
    (define/public (arg-set name)
      (make-object URI% scheme user host port path params (hash-map args cons) fragment))
    (define/public (encode)
      (url->string 
       (make-url
        scheme user host port path/params (hash-map args cons) fragment)))))

(define (decode string)
  (let ([url (string->url string)])
    (make-object URI% 
      (url-scheme url)
      (url-user url)
      (url-host url)
      (url-port url)
      (url-path url)
      (url-query url)
      (url-fragment url))))

(provide URI% decode)