response.ss

#lang scheme/base

(require "base.ss")

(require (mirrors-in)
         "core.ss")

; Procedures -------------------------------------

; controller any ... -> response
(default-controller-undefined-responder
 (lambda (controller . args)
   (make-html-response
    #:code    500
    #:message "Internal error"
    (xml (html (head (title "Controller not defined") ,stylesheet)
               (body (div (@ [id "container"])
                          (h1 "Controller not defined")
                          (p "You called the controller:")
                          (p (@ [class "example"])
                             (span (@ [class "paren"]) "(")
                             (span (@ [class "controller"]) ,(controller-id controller))
                             ,@(for/list ([arg (in-list (if (controller-requestless? controller)
                                                            args
                                                            (cons 'request args)))])
                                 (xml (span (@ [class "argument"]) ,(format " ~s" arg))))
                             (span (@ [class "paren"]) ")"))
                          (p "Unfortunately, it looks like this controller has not been defined with a "
                             (span (@ [class "controller"]) "define-controller") " statement.")
                          (p "If you have written a definition for this controller, make sure it is "
                             "directly or indirectly required by the main module that runs your application."))))))))

; controller any ... -> response
(default-access-denied-responder
 (lambda (controller . args)
   (make-html-response
    #:code    403
    #:message "Access denied"
    (xml (html (head (title "Access denied") ,stylesheet)
               (body (div (@ [id "container"])
                          (h1 "Access denied")
                          (p "You do not have permission to view this page."))))))))

; Helpers ----------------------------------------

; xml
(define stylesheet
  (xml (style (@ [type "text/css"])
              #<<ENDCSS
body { background: #eee; }
#container { border: 1px solid #aaa; background: #fff; width: 600px; margin: 50px auto; padding: 10px; }
h1 { font-family: verdana,arial,sans-serif; color: #500; margin-top: 0px; }
p { font-family: arial,sans-serif; }
.example { margin: 5px auto; text-align: center; }
.paren { font-family: monaco,monospace; color: #700; }
.controller { font-family: monaco,monospace; color: #007; }
.argument { font-family: monaco,monospace; color: #070; }
ENDCSS
              )))