;;; Reply codes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; (define http/ok 200), etc.
;;; Also, build an alist HTTP-REPLY-TEXT-TABLE mapping integer reply codes
;;; to their diagnostic text messages.

(define httpd:reply-text-table '())	; This doesn't want to be a defvar, 'cause it gets regenerated below when this file is loaded.

(defmacro httpd:define-http-reply-codes codes
  `(begin
     ,(httpd:generate-table-def codes)
     ,@(httpd:generate-code-defs codes)))

(define (httpd:generate-table-def codes)
  `(set! httpd:reply-text-table
	 ',(let lp ((codes codes))
	     (if (null? codes)
		 '()
		 (acons (cadar codes) (caddar codes)
			(lp (cdr codes)))))))

(define (httpd:generate-code-defs codes)
  (do ((codes codes (cdr codes))
       (the-result
	'()
	(cons `(define ,(prefix-symbol-with "http/" `,(caar codes))
		 ,(cadar codes))
	      the-result)))
      ((null? codes) the-result)))

(define (httpd:prefix-symbol-with string symbol)
  (string->symbol (string-append string (symbol->string symbol))))

(httpd:define-http-reply-codes
  (ok			200 "OK")
  (created		201 "Created")
  (accepted		202 "Accepted")
  (prov-info		203 "Provisional Information")
  (no-content		204 "No Content")
  (deleted              205 "Deleted")

  (mult-choice		300 "Multiple Choices")
  (moved-perm		301 "Moved Permanently")
  (moved-temp		302 "Moved Temporarily")
  (method		303 "Method (obsolete)")
  (not-mod		304 "Not Modified")

  (bad-request		400 "Bad Request")
  (unauthorized		401 "Unauthorized")
  (payment-req		402 "Payment Required")
  (forbidden		403 "Forbidden")
  (not-found		404 "Not Found")
  (method-not-allowed	405 "Method Not Allowed")
  (none-acceptable	406 "None Acceptable")
  (proxy-auth-required	407 "Proxy Authentication Required")
  (timeout		408 "Request Timeout")
  (conflict		409 "Conflict")
  (gone			410 "Gone")

  (internal-error	500 "Internal Server Error")
  (not-implemented	501 "Not Implemented")
  (bad-gateway		502 "Bad Gateway")
  (service-unavailable	503 "Service Unavailable")
  (gateway-timeout	504 "Gateway Timeout"))
	
(define (httpd:reply-code->text code)
  (cdr (assv code httpd:reply-text-table)))
