blob: fb25ba2c90a996fdbba6bf910d13de9cb5eec225 (
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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
(define-module (ldp path)
#:use-module (oop goops)
#:use-module (web uri))
(define-class <path> ()
(components-rev #:init-keyword #:components-rev #:getter path-components-rev))
(export <path>)
(define-public (is-root? x)
(equal? (path-components-rev x) '()))
(define-public (path->filename x)
(if (is-root? x)
"."
(string-append
"./"
(encode-and-join-uri-path
(map (lambda (x)
(string-append "r_" x))
(reverse (path-components-rev x)))))))
(define-public (path->uri x)
(let* ((components (reverse (path-components-rev x)))
(relative-to-root (encode-and-join-uri-path components))
(path (string-append "/" relative-to-root)))
(build-uri-reference #:path path)))
(define-public (path->string x)
(uri-path (path->uri x)))
(define-public (uri->path x)
(make <path>
#:components-rev
(reverse (split-and-decode-uri-path (uri-path x)))))
(define-public (string->path x)
(uri->path (build-uri-reference #:path x)))
(define-public (path? x)
(is-a? x <path>))
(define-public (the-path x)
(unless (path? x)
(scm-error 'wrong-type-arg
"the-path"
"Expected a path from (ldp path)."
'()
(list x)))
x)
(define-public (path-parent x)
(make <path> #:components-rev (cdr (path-components-rev x))))
(define-public (path-cons container slug)
(make <path>
#:components-rev
(cons slug (path-components-rev container))))
(define-public (path-slug x)
(car (path-components-rev x)))
(define-public (path-equal? x y)
(equal? (path-components-rev x) (path-components-rev y)))
|
