1 files changed, 112 insertions, 0 deletions
diff --git a/ldp/resource.scm b/ldp/resource.scm
new file mode 100644
index 0000000..6720499
--- /dev/null
+++ b/ldp/resource.scm
@@ -0,0 +1,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))))