1 files changed, 95 insertions, 0 deletions
diff --git a/ldp/resource/unsafe/update.scm b/ldp/resource/unsafe/update.scm
new file mode 100644
index 0000000..b563fda
--- /dev/null
+++ b/ldp/resource/unsafe/update.scm
@@ -0,0 +1,95 @@
+(define-module (ldp resource unsafe update)
+  #:use-module (ldp resource)
+  #:use-module (ldp resource unsafe save)
+  #:use-module (ldp resource load)
+  #:use-module (ldp etag)
+  #:use-module (ldp path)
+  #:use-module (ldp precondition)
+  #:use-module (turtle tordf)
+  #:use-module (rdf rdf)
+  #:use-module (rnrs bytevectors)
+  #:use-module (web uri))
+
+(define (check-triple triple)
+  (not (equal? (rdf-triple-predicate triple)
+	       "http://www.w3.org/ns/ldp#contains")))
+
+(define (check-graph graph)
+  (or (null? graph)
+      (and (check-triple (car graph))
+	   (check-graph (cdr graph)))))
+
+(define (check-container-content path content)
+  (when (bytevector? content)
+    (set! content (utf8->string content)))
+  (let ((graph (turtle->rdf (string-append "# This is not a file name."
+					   content)
+			    (uri->string (path->uri path)))))
+    (unless (check-graph graph)
+      (throw 'conflict))))
+
+(define-public (initialize-root)
+  (catch 'not-found
+    (lambda ()
+      (load "")
+      #t)
+    (lambda error
+      (save (make-resource (string->path "")
+			   (generate-etag)
+			   'text/turtle
+			   '())
+	    "")
+      (initialize-root))))
+
+(define-public (change-contained path precondition added removed)
+  (call-with-values (lambda () (load path))
+    (lambda (resource _port _triples)
+      (unless (container? resource)
+	(throw 'cannot-add-resources-in-non-container))
+      (unless (precondition-valid? precondition (resource-etag resource))
+	(throw 'precondition-failed))
+      (let ((updated (update-children resource added removed)))
+	(save-manifest updated)))))
+
+(define-public (change-representation path precondition content-type content)
+  (call-with-values (lambda () (load path))
+    (lambda (resource _port _triples)
+      (unless (precondition-valid? precondition (resource-etag resource))
+	(throw 'precondition-failed))
+      (let ((updated (make-resource path
+				    (generate-etag)
+				    content-type
+				    (resource-contained resource))))
+	(when (container? updated)
+	  (check-container-content path content))
+	(save updated content)))))
+
+(define-public (delete path precondition)
+  (call-with-values (lambda () (load path))
+    (lambda (resource _port _triples)
+      (unless (precondition-valid? precondition (resource-etag resource))
+	(throw 'precondition-failed))
+      (unless (or (not (resource-contained resource))
+		  (null? (resource-contained resource)))
+	(throw 'non-empty-container))
+      (unless (not (is-root? path))
+	(throw 'cannot-delete-the-root))
+      (change-contained (path-parent path)
+			(make-precondition #f #f)
+			'()
+			(list path)))))
+
+(define-public (mkcont-recursive path)
+  (catch 'not-found
+    (lambda ()
+      (call-with-values (lambda () (load path))
+	(lambda (_resource _port _triples)
+	  #t)))
+    (lambda error
+      (unless (is-root? path)
+	(mkcont-recursive (path-parent path)))
+      (save (make-resource path
+			   (generate-etag)
+			   'text/turtle
+			   '())
+	    ""))))