diff options
Diffstat (limited to 'ldp/resource/unsafe/update.scm')
-rw-r--r-- | ldp/resource/unsafe/update.scm | 95 |
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 + '()) + "")))) |