Adding path-resolve and uri-resolve utilities.

This commit is contained in:
Alex Shinn 2014-07-08 22:40:53 +09:00
parent 78f31ede20
commit 6be655083c
4 changed files with 25 additions and 3 deletions

View file

@ -121,6 +121,12 @@
(else (else
#f)))) #f))))
;;> Resolve \var{path} relative to the given directory. Returns
;;> \var{path} unchanged if already absolute.
(define (path-resolve path dir)
(if (path-absolute? path) path (make-path dir path)))
;; This looks big and hairy, but it's mutation-free and guarantees: ;; This looks big and hairy, but it's mutation-free and guarantees:
;; (string=? s (path-normalize s)) <=> (eq? s (path-normalize s)) ;; (string=? s (path-normalize s)) <=> (eq? s (path-normalize s))
;; i.e. fast and simple for already normalized paths. ;; i.e. fast and simple for already normalized paths.

View file

@ -3,6 +3,6 @@
(export path-strip-directory path-directory (export path-strip-directory path-directory
path-extension path-strip-extension path-replace-extension path-extension path-strip-extension path-replace-extension
path-absolute? path-relative? path-strip-leading-parents path-absolute? path-relative? path-strip-leading-parents
path-relative-to path-normalize make-path) path-relative-to path-resolve path-normalize make-path)
(import (chibi) (chibi string)) (import (chibi) (chibi string))
(include "pathname.scm")) (include "pathname.scm"))

View file

@ -323,3 +323,19 @@
(if (null? ls) (if (null? ls)
(string-concatenate (reverse res)) (string-concatenate (reverse res))
(lp (car ls) (cdr ls) (cons "&" res))))))) (lp (car ls) (cdr ls) (cons "&" res)))))))
;;> Returns a new URI from \var{path}, a string or URI object, as
;;> would be interpreted from as a reference from \var{uri}. Thus if
;;> any components of \var{path} are missing, or if \var{path} is a
;;> raw path, it is taken relative to \var{uri}.
(define (uri-resolve path uri)
(or (string->uri path)
(let ((uri (string->uri uri)))
(and uri
(uri-with-path
(uri-with-fragment (uri-with-query uri #f) #f)
(path-resolve path
(if (string-suffix? (uri-path uri) "/")
(uri-path uri)
(path-directory (uri-path uri)))))))))

View file

@ -3,7 +3,7 @@
(export uri? uri->string make-uri string->uri string->path-uri uri-has-scheme? (export uri? uri->string make-uri string->uri string->path-uri uri-has-scheme?
uri-scheme uri-user uri-host uri-port uri-path uri-query uri-fragment uri-scheme uri-user uri-host uri-port uri-path uri-query uri-fragment
uri-with-scheme uri-with-user uri-with-host uri-with-path uri-with-scheme uri-with-user uri-with-host uri-with-path
uri-with-query uri-with-fragment uri-with-query uri-with-fragment uri-resolve
uri-encode uri-decode uri-query->alist uri-alist->query) uri-encode uri-decode uri-query->alist uri-alist->query)
(import (chibi) (chibi string) (srfi 9)) (import (chibi) (chibi string) (chibi pathname) (srfi 9))
(include "uri.scm")) (include "uri.scm"))