#lang scheme/base

(require net/url
         scheme/contract
         web-server/configuration/namespace
         web-server/dispatchers/dispatch
         (prefix-in file:      web-server/dispatchers/dispatch-files)
         (prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
         (prefix-in servlet:   web-server/dispatchers/dispatch-servlets)
         web-server/dispatchers/filesystem-map
         web-server/http
         web-server/private/cache-table
         web-server/private/mime-types
         web-server/servlet/setup)

;  (connection request -> void)
;  #:htdocs-paths    (listof (U path string))
;  #:mime-types-path path
; ->
;  dispatcher
;
; When they are not being used, #:servlet-path, #:servlet-namespace or #:custom-dispatcher must be #f.
; exn:fail:contract is raised if this is not the case.
(define (make-instaweb-dispatcher dispatch-app
                                  #:htdocs-paths   htdocs-paths
                                  #:mime-types-path mime-types-path)
  
  ; URL->path convertors -----------------------
  
  ; path -> (url -> path (list-of path-element))
  (define (htdocs-url->path path)
    (make-url->path (path->complete-path path)))
  
  ; Dispatchers --------------------------------
  
  ; (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-paths)))
  
  ; connection request -> response
  (sequencer:make dispatch-htdocs dispatch-app))

;  #:servlet-path        (U path string #f)
;  #:servlet-namespace   (U (listof require-spec) #f)
;  #:servlet-exn-handler (-> url exn response)
; ->
;  (connection request -> void)
(define (make-application-dispatcher #:servlet-path        servlet-path
                                     #:servlet-namespace   servlet-namespace
                                     #:servlet-exn-handler servlet-exn-handler)
  
  ; make-servlet-namespace
  (define make-servlet-namespace
    (make-make-servlet-namespace #:to-be-copied-module-specs servlet-namespace))
  
  ; -> void
  ; url -> servlet
  (define-values (clear-cache! url->servlet)
    (servlet:make-cached-url->servlet
     (lambda (url)
       (values servlet-path null))
     (make-default-path->servlet #:make-servlet-namespace make-servlet-namespace)))
  
  ; url -> path (list-of path-element)
  (define servlet-url->path
    (let ([path (path->complete-path servlet-path)])
      (lambda (url)
        (values path null))))
  
  (servlet:make url->servlet #:responders-servlet servlet-exn-handler))

; Provide statements -----------------------------

(provide/contract
 [make-instaweb-dispatcher    (-> dispatcher/c
                                  #:htdocs-paths        (listof (or/c path? string?))
                                  #:mime-types-path     path?
                                  dispatcher/c)]
 [make-application-dispatcher (-> #:servlet-path        (and/c path? absolute-path?)
                                  #:servlet-namespace   list?
                                  #:servlet-exn-handler (-> url? exn? response?)
                                  dispatcher/c)])