blob: 7e40259a659822240d92ca7a94aaf1242d90f5b8 (
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
44
45
46
|
(define-module (hnh util path)
:use-module (srfi srfi-1)
:use-module (hnh util))
(define-public (path-append . strings)
(fold (lambda (s done)
(string-append
done
(if (string-null? s)
(string-append s file-name-separator-string)
(if (file-name-separator? (string-last done))
(if (file-name-separator? (string-first s))
(string-drop s 1) s)
(if (file-name-separator? (string-first s))
s (string-append file-name-separator-string s))))))
;; If first component is empty, add a leading slash to make
;; the path absolute. This isn't exactly correct if we have
;; drive letters, but on those system the user should make
;; sure that the first component of the path is non-empty.
(let ((s (car strings)))
(if (string-null? s)
file-name-separator-string 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))))
|
