(define-module (ldp resource update)
  #:use-module (ldp etag)
  #:use-module (ldp path)
  #:use-module (ldp resource)
  #:use-module (ldp http-link)
  #:use-module (ldp precondition)
  #:use-module (ldp resource unsafe save)
  #:use-module (ice-9 threads)
  #:use-module (web uri)
  #:use-module ((ldp resource unsafe update) #:prefix unsafe:))

;; FIXME: use a bag of locks, so that we can have concurrent updates
;; of different resources.
(define lock (make-mutex))

(define-public (initialize-root)
  (with-mutex lock
    (unsafe:initialize-root)))

(define-public (delete path precondition)
  (with-mutex lock
    (unsafe:delete path precondition)))

(define (links-hint-for-a-container link-header)
  (define (has-rel-type properties)
    (if (null? properties)
	#f
	(let* ((prop (car properties))
	       (key (car prop))
	       (value (cdr prop)))
	  (if (and (string=? key "rel")
		   (or (string=? value "type")
		       (string=? value "http://www.w3.org/1999/02/22-rdf-syntax-ns#type")))
	      #t
	      (has-rel-type (cdr properties))))))
  (and link-header
       (let ((links (string->links link-header)))
	 (let ((for-basic-container
		(or
		 (assoc-ref links
			    (string->uri
			     "http://www.w3.org/ns/ldp/BasicContainer"))
		 '()))
	       (for-container
		(or
		 (assoc-ref links
			    (string->uri
			     "http://www.w3.org/ns/ldp/Container"))
		 '())))
	   (has-rel-type (append for-basic-container for-container))))))

(define-public (post path slug precondition
		     http-link-header content-type content)
  (catch 'child-already-exists
    (lambda ()
      (let ((child-path (path-cons path slug)))
	(let ((new-resource
	       (make-resource
		child-path
		(generate-etag)
		content-type
		(and (links-hint-for-a-container http-link-header)
		     '()))))
	  (with-mutex lock
	    (unsafe:mkcont-recursive path)
	    (unsafe:change-contained path precondition
				     (list child-path)
				     '())
	    (save new-resource content)
	    new-resource))))
    (lambda err
      (post path (string-append slug "-" (generate-etag))
	    precondition
	    http-link-header content-type content))))

(define-public (put path precondition
		    http-link-header content-type content)
  (let ((new-resource
	 (make-resource
	  path
	  (generate-etag)
	  content-type
	  (and (links-hint-for-a-container http-link-header)
	       '()))))
    (with-mutex lock
      (if (is-root? path)
	  (unsafe:initialize-root)
	  (unsafe:mkcont-recursive (path-parent path)))
      (catch 'not-found
	(lambda ()
	  (unsafe:change-representation path precondition
					content-type content))
	(lambda error
	  ;; path is not the root, because it exists from the
	  ;; beginning of the locked section
	  (unsafe:change-contained (path-parent path)
				   (make-precondition #f #f)
				   (list path)
				   '())
	  (save new-resource content)
	  new-resource)))))