diff options
Diffstat (limited to 'src/guile')
| -rw-r--r-- | src/guile/cantius.scm | 25 |
1 files changed, 25 insertions, 0 deletions
diff --git a/src/guile/cantius.scm b/src/guile/cantius.scm index 601427e..648a5a2 100644 --- a/src/guile/cantius.scm +++ b/src/guile/cantius.scm @@ -41,6 +41,31 @@ (s35:define-condition-type &forbidden s35:&condition forbidden-condition?) +(define-public (normalize-path path) + (define absolute? + (eqv? #\/ (string-ref path 0))) + + (let loop ((parent-walks 0) + (processed '()) + (to-process (string-split path #\/))) + (match (list parent-walks processed to-process) + ((0 () ()) + (if absolute? "/" ".")) + ((_ _ ()) + (string-join (append (map (const "..") (iota parent-walks)) + (reverse processed)) + "/" + (if absolute? 'prefix 'infix))) + ((_ _ ((? (cut member <> '("" "."))) + . rest)) + (loop parent-walks processed rest)) + ((_ () (".." . rest)) + (loop (1+ parent-walks) '() rest)) + ((_ (_ . processed-rest) (".." . rest)) + (loop parent-walks processed-rest rest)) + ((_ _ (segment . rest)) + (loop parent-walks (cons segment processed) rest))))) + (export find-resource-file) (define* (find-resource-file file #:optional (root-path (%resource-root-path))) (unless (legal-path? file) |