(define-module (ldp response)
  #:use-module (ldp path)
  #:use-module (ldp resource)
  #:use-module (web response))

(define-public (respond-not-found)
  (values (build-response
	   #:code 404
	   #:reason-phrase "Not Found")
	  #f))

(define-public (respond-bad-request)
  (values (build-response
	   #:code 400
	   #:reason-phrase "Bad Request")
	  #f))

(define-public (respond-not-modified)
  (values (build-response
	   #:code 304
	   #:reason-phrase "Not Modified")
	  #f))

(define-public (respond-precondition-failed)
  (values (build-response
	   #:code 412
	   #:reason-phrase "Precondition Failed")
	  #f))

(define-public (respond-conflict)
  (values (build-response
	   #:code 409
	   #:reason-phrase "Conflict")
	  #f))

(define-public (respond-method-not-allowed)
  (values (build-response
	   #:code 405
	   #:reason-phrase "Method Not Allowed")
	  #f))

(define-public (respond-to-error key . args)
  (case key
    ((not-found)
     (respond-not-found))
    ((bad-request)
     (respond-bad-request))
    ((not-modified)
     (respond-not-modified))
    ((precondition-failed)
     (respond-precondition-failed))
    ((conflict cannot-delete-the-root)
     (respond-conflict))
    ((method-not-allowed cannot-add-resources-in-non-container)
     (respond-method-not-allowed))
    (else
     (apply throw key args))))

(define-public (respond-to-post resource)
  (values (build-response
	   #:code 201
	   #:reason-phrase "Created"
	   #:headers `((location . ,(path->uri (resource-path resource)))))
	  #f))

(define-public (respond-to-put)
  (values (build-response)
	  #f))

(define-public (respond-to-delete)
  (values (build-response)
	  #f))

(define-public (respond-to-get resource data)
  (values (build-response
	   #:headers `((content-type . (,(resource-content-type resource)))
		       (etag . ,(resource-etag resource))
		       (allow HEAD GET POST PUT DELETE OPTIONS)))
	  data))

(define-public (respond-to-head resource)
  (values (build-response
	   #:headers `((content-type . (,(resource-content-type resource)))
		       (etag . ,(resource-etag resource))
		       (allow HEAD GET POST PUT DELETE OPTIONS)))
	  #f))

(define-public (respond-to-options resource)
  (let ((allow
	 (cond ((is-root? (resource-path resource))
		'(HEAD GET POST PUT OPTIONS))
	       ((container? resource)
		'(HEAD GET POST PUT DELETE OPTIONS))
	       (else
		'(HEAD GET PUT DELETE OPTIONS)))))
    (values (build-response
	     #:code 204
	     #:reason-phrase "No Content"
	     #:headers `((content-type . (,(resource-content-type resource)))
			 (etag . ,(resource-etag resource))
			 (allow . ,allow)))
	    #f)))