1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

(define-module (path-utils)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 regex)
  #:export (path-normalize
            path-append
            path-abs
            path-extension))

(define (path-normalize p)
  "removes // and . and .. from a path
   example:
     (path-normalize \"/lol//fu.ck/./you/./asdfjkl/../\")
     $1 = \"/lol/fu.ck/you/\""
  (define (filter.. v prev acc rest)
    (if (null? rest)
        (let ((result (if prev (append acc (list prev)) acc)))
          (append result (list v)))
        (if (and prev (string-null? v))
            (filter.. (car rest) prev acc (cdr rest))
            (if (and (string= v "..")
                     prev
                     (not (string= prev "..")))
                (filter.. (car rest) #f acc (cdr rest))
                (filter.. (car rest) v (if prev
                                           (append acc (list prev))
                                           acc)
                          (cdr rest))))))
  (let* ((parts (string-split p #\/))
         (parts' (filter (lambda (v) (not (string= v "."))) parts))
         (parts'' (filter.. (car parts') #f '() (cdr parts'))))
    (string-join parts'' "/")))

(define* (path-append acc #:optional . e)
  (define (append-p a b)
    (if (or (string-match (string-append file-name-separator-string "$") a)
            (string-match (string-append "^" file-name-separator-string) b))
        (string-append a b)
        (string-append a file-name-separator-string b)))
  (path-normalize (fold (lambda (v acc) (append-p acc v)) acc e)))

(define* (path-abs p #:optional (base (getcwd)))
  (path-append base p))

(define (path-extension file-path)
  "returns the part after the last dot, otherwise empty string.
   example: \"test.scm\" -> \".scm\"
            \"test\" -> \"\""
  ;; TODO only do this when it's after the last dir-separator
  (let ((match (regexp-exec (make-regexp "\\.(.+)$" regexp/icase) file-path)))
    (if match
        (match:substring match)
        "")))