Add `normalize-path` function.

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)