;; facade for the webserver utilities and internal components used in
;; the sweb application.

#lang scheme/base

(require
 "sweb.ss"
 (lib "servlet.ss" "web-server")
 (lib "url.ss" "net")
 (lib "control.ss")
 ;;eb-server/servlet/helpers  ;; redirect-to
 web-server/http/redirect ;; redirect-to
 web-server/configuration/responders
 web-server/http/xexpr
 )

(provide
 not-found
 redirect-to
 refresh-to
 req->strings
 req->list ;; shortcut
 with-error-response
 error-response
 error-404
 mime
 response/xexpr
 )

;; cleaner way?
(define (not-found)
  (file-response
   404 #"File not found"
   (sweb-file "conf/not-found.html")))

(define (refresh-to url)
  `(html
    (head
     (meta
      ((http-equiv "refresh")
       (content ,(format "0;~a" url)))))))


;; exceptions are for genuine errors. returning an error page is
;; similar, but it seems more natural to use prompt/abort for these.

;; Error response control abstractions.
(define error-tag
  (make-continuation-prompt-tag 'error-response))
(define (error-response r)
  (abort-current-continuation error-tag (lambda () r)))
(define (with-error-response thunk)
  (prompt-at error-tag (thunk)))

;; Particular error escape response thunks.
(define (error-404 . args)
  (printf "error-404: ~a\n" args)
  (error-response (not-found)))

(define (req->strings req)
  (map path/param-path
       (url-path
        (request-uri req))))

;; using default server layout: strip /servlets/<name>/
(define (req->list req)
  (cddr (req->strings req)))




(define (mime type bytes)
  (when (string? bytes)
    (set! bytes (string->bytes/utf-8 bytes)))
  (and bytes
       (;; make-response/full ;; 4.x
        response/full ;; 5.x
        200
        #"Okay"
        (current-seconds)
        type
        '()
        (list bytes))))