1 files changed, 102 insertions, 0 deletions
diff --git a/ldp/response.scm b/ldp/response.scm
new file mode 100644
index 0000000..a822979
--- /dev/null
+++ b/ldp/response.scm
@@ -0,0 +1,102 @@
+(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)))