;;;
;;; Time-stamp: <06/05/17 15:30:04 noel>
;;;
;;; Copyright (C) by Noel Welsh.
;;;

;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.

;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.

;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA

;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:

#lang scheme/base

(require (for-syntax scheme/base)
         scheme/runtime-path)

(provide (all-defined-out))

; Instaweb defaults

(define-runtime-path default-mime-types-path "mime.types")

(define default-servlet-name "servlet.ss")
(define default-servlet-path (build-path (current-directory) default-servlet-name))

(define default-htdocs-name "htdocs")
(define default-htdocs-path (list (build-path (current-directory) default-htdocs-name)))

(define default-servlet-namespace null)

(define (default-servlet-exn-handler url exn)
  (define (format-stack-trace trace)
    `(pre
      ,@(for/list ([item (in-list trace)])
          (format "~a at:~n  ~a~n"
                  (if (car item)
                      (car item)
                      "<unknown procedure>")
                  (if (cdr item)
                      (format "line ~a, column ~a, in file ~a"
                              (srcloc-line (cdr item))
                              (srcloc-column (cdr item))
                              (srcloc-source (cdr item)))
                      "<unknown location>")))))
  (let ([stylesheet #<<EOF
.section {
  margin: 25px;
  font-family: sans-serif;
  border: 1px solid black;
}

.title {
  background-color: #663366;
  font-size: large;
  padding: 5px;
  color: #FFFFFF;
}

.section > p {
  margin-left: 5px;
  margin-right: 5px;
}

.section > pre {
  background-color: #ffccff;
  margin-left: 5px;
  margin-right: 5px;
  padding: 5px;
  border: 1px solid #ff99ff;
}
EOF
                    ])
    `(html
      (head
       (title "Servlet Error")
       (style ([type "text/css"])
              ,stylesheet)
       (body
        (div ([class "section"])
             (div ([class "title"]) "Exception")
             (p
              "Your application raised an exception with the message:"
              (pre ,(exn-message exn)))
             (p
              "Stack trace:"
              ,(format-stack-trace
                (continuation-mark-set->context (exn-continuation-marks exn))))))))))