#lang scheme/base

(require web-server/configuration/namespace
         (prefix-in file:      web-server/dispatchers/dispatch-files)
         (prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
         (prefix-in servlet:   web-server/dispatchers/dispatch-servlets)
         (prefix-in lang:      web-server/dispatchers/dispatch-lang)
         web-server/dispatchers/filesystem-map
         web-server/private/cache-table
         web-server/private/mime-types)

;  #:app-dispatcher  (connection request -> void)
;  #:htdocs-path     (listof (U path string))
;  #:mime-types-path path
; ->
;  dispatcher
;
; If #:servlet-lang is custom, #:custom-dispatcher is invoked to create the servlet part of the dispatcher.
; If #:servlet-lang is any other value, #:servlet-path and #:servlet-namespace are used to specify the arguments
; to the appropriate default constructor from web server.
;
; 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
         #:app-dispatcher  dispatch-application
         #:htdocs-path     htdocs-path
         #: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-path)))
  
  ; connection request -> response
  (sequencer:make dispatch-htdocs dispatch-application))

;  #:servlet-lang      (U 'mzscheme 'scheme 'scheme/base 'web-server)
;  #:servlet-path      (U path string #f)
;  #:servlet-namespace (U (listof require-spec) #f)
; ->
;  clear-table-thunk
;  dispatcher
(define (make-application-dispatcher
         #:servlet-lang      servlet-lang
         #:servlet-path      servlet-path
         #:servlet-namespace servlet-namespace)
  
  ; URL->path convertors -----------------------
  
  ; url -> path (list-of path-element)
  (define (servlet-url->path url)
    (let ([complete-servlet-path (path->complete-path servlet-path)])
      (values complete-servlet-path null)))
  
  ; Return the dispatcher ------------------------
  
  (if (eq? servlet-lang 'web-server)
      (let ([make-servlet-namespace (make-make-servlet-namespace #:to-be-copied-module-specs servlet-namespace)])
        (lang:make #:url->path servlet-url->path
                   #:make-servlet-namespace make-servlet-namespace))
      (let ([make-servlet-namespace (make-make-servlet-namespace #:to-be-copied-module-specs servlet-namespace)])
        (let-values ([(clear-table! dispatcher)
                      (servlet:make (box (make-cache-table))
                                    #:url->path servlet-url->path
                                    #:make-servlet-namespace make-servlet-namespace)])
          dispatcher))))

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

(provide make-instaweb-dispatcher
         make-application-dispatcher)