#lang scheme/base
(require (lib "url.ss" "net")
(lib "cut.ss" "srfi" "26")
(lib "web-server.ss" "web-server")
(lib "namespace.ss" "web-server" "configuration")
(lib "dispatch.ss" "web-server" "dispatchers")
(prefix-in file: (lib "dispatch-files.ss" "web-server" "dispatchers"))
(prefix-in filter: (lib "dispatch-filter.ss" "web-server" "dispatchers"))
(prefix-in sequencer: (lib "dispatch-sequencer.ss" "web-server" "dispatchers"))
(prefix-in servlet: (lib "dispatch-servlets.ss" "web-server" "dispatchers"))
(lib "filesystem-map.ss" "web-server" "dispatchers")
(lib "cache-table.ss" "web-server" "private")
(lib "mime-types.ss" "web-server" "private")
(lib "request-structs.ss" "web-server" "private")
(lib "util.ss" "web-server" "private"))
(provide make)
(define (make #:servlet-path servlet-path
#:htdocs-path htdocs-path
#:mime-types-path mime-types-path
#:servlet-namespace servlet-namespace)
(define (servlet-url->path url)
(let ([complete-servlet-path (path->complete-path servlet-path)])
(values complete-servlet-path (explode-path* complete-servlet-path))))
(define (htdocs-url->path path)
(make-url->path (path->complete-path path)))
(define dispatch-htdocs
(apply
sequencer:make
(map
(lambda (path)
(file:make #:url->path (htdocs-url->path path)
#:path->mime-type (make-path->mime-type
(path->complete-path mime-types-path))))
htdocs-path)))
(define make-servlet-namespace
(make-make-servlet-namespace
#:to-be-copied-module-specs servlet-namespace))
(define-values (clear-servlet-cache! dispatch-servlets)
(servlet:make (box (make-cache-table))
#:url->path servlet-url->path
#:make-servlet-namespace make-servlet-namespace))
(define dispatch-all
(sequencer:make dispatch-htdocs
dispatch-servlets))
dispatch-all)