(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
			   '())
	    ""))))