dispatcher.ss
#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)

;; Default paths and names

;; make : #:servlet-path      (U path string)
;;        #:htdocs-path       (listof (U path string))
;;        #:mime-types-path   path
;;        #:servlet-namespace (listof require-spec)
;;  ->
;;        dispatcher
(define (make #:servlet-path      servlet-path
              #:htdocs-path       htdocs-path
              #:mime-types-path   mime-types-path
              #:servlet-namespace servlet-namespace)
  
  ;; 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)