blob: 672049929442617aadef95df960d6ec411c215f2 (
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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
(define-module (ldp resource)
#:use-module (ldp path)
#:use-module (ldp etag)
#:use-module (oop goops)
#:use-module (web uri))
;; If contained is #f, then this is not a container. Otherwise, this
;; is a container, possibly empty (null)
(define-class <resource> ()
(path #:init-keyword #:path #:getter resource-path)
(etag #:init-keyword #:etag #:getter resource-etag)
(content-type #:init-keyword #:content-type #:getter resource-content-type)
(contained #:init-keyword #:contained #:getter resource-contained))
(export resource-path
resource-etag
resource-content-type
resource-contained)
(define (the-symbol x)
(unless (symbol? x)
(scm-error 'wrong-type-arg
"the-symbol"
"Expected a symbol, got ~s."
(list x)
(list x)))
x)
(define-public (make-resource path etag content-type contained)
(unless (or (not contained)
(eq? content-type 'text/turtle))
(throw 'containers-should-be-rdf))
(make <resource>
#:path (the-path path)
#:etag (the-etag etag)
#:content-type (the-symbol content-type)
#:contained (and contained
(map the-path contained))))
(define-public (resource? x)
(is-a? x <resource>))
(define-public (container? x)
(and (resource? x)
(resource-contained x)))
(define-public (the-resource x)
(unless (resource? x)
(scm-error 'wrong-type-arg
"the-non-container"
"Expected a resource from (ldp resource)."
'()
(list x)))
x)
(define-public (the-container x)
(unless (container? x)
(scm-error 'wrong-type-arg
"the-container"
"Expected a container from (ldp resource)."
'()
(list x)))
x)
(define-method (has-child? (container <resource>) (child <path>))
(define (check list)
(and (not (null? list))
(or (path-equal? (car list) child)
(check (cdr list)))))
(check (resource-contained container)))
(export has-child?)
(define-public (add-child container child)
(set! container (the-container container))
(set! child (the-path child))
(if (has-child? container child)
(throw 'child-already-exists)
(make-resource (resource-path container)
(generate-etag)
(resource-content-type container)
(cons child (resource-contained container)))))
(define-public (remove-child container child)
(set! container (the-container container))
(set! child (the-path child))
(define (check found kept list)
(if (null? list)
(if found
(reverse kept)
(throw 'child-does-not-exist))
(if (path-equal? (car list) child)
(check #t kept (cdr list))
(check found (cons (car list) kept) (cdr list)))))
(make-resource (resource-path container)
(generate-etag)
(resource-content-type container)
(check #f '() (resource-contained container))))
(define-public (update-children container added removed)
(set! container (the-container container))
(set! added (map the-path added))
(set! removed (map the-path removed))
(cond
((and (null? added) (null? removed))
container)
((null? added)
(update-children (remove-child container (car removed))
'() (cdr removed)))
(else
(update-children (add-child container (car added))
(cdr added) removed))))
|
