response.scm
(module response mzscheme
  (provide (all-defined))
  
  (require (lib "kw.ss")
           (lib "response.ss" "web-server")
           "cookie.scm"
           "doctype.scm")
  
  (define current-response-code    (make-parameter 200))
  (define current-response-message (make-parameter "Okay"))
  (define current-response-seconds (make-parameter (current-seconds)))
  (define current-response-mime    (make-parameter (string->bytes/utf-8 "text/html")))
  (define current-response-extras  (make-parameter '()))
  ; (define current-response-body    (make-parameter #f))

  ; if one of the redirect parameters are assigned an url (as a string)
  ; then a redirect repsponse is sent
  (define current-redirect-permanently (make-parameter #f))  ; 301
  (define current-redirect-temporarily (make-parameter #f))  ; 302
  (define current-redirect-see-other   (make-parameter #f))  ; 303
  
  (define/kw (make-response 
              document #:key
              (code    (current-response-code))
              (message (current-response-message))
              (seconds (current-response-seconds))
              (mime    (current-response-mime)))
    
    (let* ([cookies 
            (map (lambda (c) `(Set-Cookie . ,c)) 
                 (current-output-cookies))]
           [extras  
            (append cookies 
                    (current-response-extras))])
      
      #;(begin  ; uncomment when debugging
          (display (list (current-redirect-permanently)
                         (current-redirect-temporarily)
                         (current-redirect-see-other)))
          (newline))
      
      (cond
        [(or (current-redirect-permanently)
             (current-redirect-temporarily)
             (current-redirect-see-other))
         (let-values 
             ([(code message url)
               (cond
                 [(current-redirect-permanently) => (λ (url) (values 301 "Moved Permanently" url))]
                 [(current-redirect-temporarily) => (λ (url) (values 302 "Moved Temporarily" url))]
                 [(current-redirect-see-other)   => (λ (url) (values 303 "See Other"         url))])])
           (make-response/full code message seconds mime 
                               (list `(location . ,url))
                               ;(cons `(location . ,url) extras)
                               (list (current-doctype)
                                     document)))]
        [else
         ; normal response
         (make-response/full code message seconds mime extras
                             (list (current-doctype)
                                   document))])))
  )