aboutsummaryrefslogtreecommitdiff
path: root/module/hnh/util/path.scm
blob: 49338d019b0316358654bac8ccacce826f83f70c (plain)
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
(define-module (hnh util path)
  :use-module (srfi srfi-1)
  :use-module (hnh util))

;; TODO shouldn't this use `file-name-separator-string'?
(define-public (path-append . strings)
  (fold (lambda (s done)
            (string-append
             done
             (if (string-null? s)
                 (string-append s "/")
                 (if (char=? #\/ (string-last done))
                     (if (char=? #\/ (string-first s))
                         (string-drop s 1) s)
                     (if (char=? #\/ (string-first s))
                         s (string-append "/" s))))))
        (let ((s (car strings)))
          (if (string-null? s)
              "/" s))
        (cdr strings)))

(define-public (path-join lst) (apply path-append lst))

;; @example
;; (path-split "usr/lib/test")
;; ⇒ ("usr" "lib" "test")
;; (path-split "/usr/lib/test")
;; ⇒ ("" "usr" "lib" "test")
;; (path-split "//usr////lib/test")
;; ⇒ ("" "usr" "lib" "test")
;; @end example
(define-public (path-split path)
  (let* ((head tail
               (car+cdr
                (reverse
                 (map reverse-list->string
                      (fold (lambda (c done)
                              (if (file-name-separator? c)
                                  (cons '() done)
                                  (cons (cons c (car done)) (cdr done))))
                            '(())
                            (string->list path)))))))
    (cons head (remove string-null? tail))))