dispatcher.ss
(module dispatcher mzscheme

  (require (lib "kw.ss")
           (lib "runtime-path.ss")
           (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 file: (lib "dispatch-files.ss" "web-server" "dispatchers"))
           (prefix filter: (lib "dispatch-filter.ss" "web-server" "dispatchers"))
           (prefix sequencer: (lib "dispatch-sequencer.ss" "web-server" "dispatchers"))
           (prefix 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)

  ;; Default paths and names
  
  (define-runtime-path default-mime-types-path "mime.types")
  (define default-servlet-name "servlet.ss")
  (define default-htdocs-name "htdocs")

  ;; make : [#:servlet-path (U path string)]
  ;;        [#:htdocs-path (listof (U path string))]
  ;;        [#:mime-types-path path]
  ;;        [#:servlet-namespace (listof require-spec)]
  ;;  ->
  ;;        dispatcher
  (define make
    (lambda/kw
     (#:key [servlet-path
             (build-path (current-directory) default-servlet-name)]
            [htdocs-path
             (list (build-path (current-directory) default-htdocs-name))]
            [mime-types-path default-mime-types-path]
            [servlet-namespace null])
     
     ;; URL->path convertors -------------------------
  
     ;; serlvet-url->path : url -> path (list-of path-element)
     (define (servlet-url->path url)
       (let ([complete-servlet-path (path->complete-path servlet-path)])
         (values complete-servlet-path (explode-path* complete-servlet-path))))

     ;; htdocs-url->path : path -> (url -> path (list-of path-element))
     (define (htdocs-url->path path)
       (make-url->path (path->complete-path path)))
  
     ;; Dispatchers ----------------------------------
  
     ;; dispatch-htdocs : (connection request -> response)
     (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)))

     ;; somethink keywordy -> namespace
     (define make-servlet-namespace
       (make-make-servlet-namespace
        #:to-be-copied-module-specs servlet-namespace))
  
     ;; clear-servlet-cache! : -> void
     ;; dispatch-servlets:    connection request -> response
     (define-values (clear-servlet-cache! dispatch-servlets)
       (servlet:make (box (make-cache-table))
                     #:url->path servlet-url->path
                     #:make-servlet-namespace make-servlet-namespace))
  
     ;; dispatch-all : connection request -> response
     (define dispatch-all
       (sequencer:make dispatch-htdocs
                       dispatch-servlets))

     dispatch-all))
     
  )