#lang scheme/base

(require web-server/web-server
         (file "defaults.ss")
         (file "dispatcher.ss"))

; Main entry points ------------------------------

;  [#:port              integer]
;  [#listen-ip          (U string #f)]
;  [#:servlet-lang      (U 'mzscheme 'scheme 'scheme/base 'web-server)]
;  [#:servlet-path      (U path string #f)]
;  [#:servlet-namespace (listof require-spec)]
;  [#:htdocs-path       (listof (U path string))]
;  [#:mime-types-path   path]
; ->
;  void
(define (instaweb
         #:port                [port                8765]
         #:listen-ip           [listen-ip           "127.0.0.1"]
         #:servlet-lang        [servlet-lang        'scheme/base]
         #:servlet-path        [servlet-path        default-servlet-path]
         #:servlet-namespace   [servlet-namespace   default-servlet-namespace]
         #:servlet-exn-handler [servlet-exn-handler default-servlet-exn-handler]
         #:htdocs-path         [htdocs-path         default-htdocs-path]
         #:mime-types-path     [mime-types-path     default-mime-types-path])
  (instaweb/dispatcher
   #:port            port 
   #:listen-ip       listen-ip
   #:app-dispatcher  (make-application-dispatcher
                      #:servlet-lang      servlet-lang
                      #:servlet-path      servlet-path
                      #:servlet-exn-handler servlet-exn-handler
                      #:servlet-namespace servlet-namespace)
   #:htdocs-path     htdocs-path
   #:mime-types-path mime-types-path))

;  [#:port              integer]
;  [#listen-ip          (U string #f)]
;   #:app-dispatcher    (connection request -> void)
;  [#:htdocs-path       (listof (U path string))]
;  [#:mime-types-path   path]
; ->
;  void
(define (instaweb/dispatcher
         #:port              [port            8765]
         #:listen-ip         [listen-ip       "127.0.0.1"]
         #:app-dispatcher    app-dispatcher
         #:htdocs-path       [htdocs-path     default-htdocs-path]
         #:mime-types-path   [mime-types-path default-mime-types-path])
  (define instaweb-dispatcher
    (make-instaweb-dispatcher
     #:app-dispatcher  app-dispatcher
     #:htdocs-path     htdocs-path
     #:mime-types-path mime-types-path))
  (define (run-server-thunk)
    (run-server port listen-ip #:dispatcher instaweb-dispatcher))
  (parameterize
      ([print-hash-table #t]
       [print-struct #t]
       [error-print-width 1024]
       [error-print-context-length 50])
    (console-loop run-server-thunk)))

; Utilities --------------------------------------

;  integer
;  (U string #f)
;  #:dispatcher (connection request -> void)
; ->
;  stop-server-thunk
(define (run-server port listen-ip #:dispatcher dispatcher)
  (begin0 (serve #:dispatch  dispatcher
                 #:port      port
                 #:listen-ip listen-ip)
          (printf "Web server started on port ~a\n" port)
          (printf "Listening on IP address: ~a\n"
                  (if listen-ip listen-ip "all addresses"))))

; (-> stop-server-thunk) -> void
(define (console-loop run-server)
  (define (display-usage)
    (printf "Type \"stop\" to stop the server and exit.\n")
    (printf "Type \"restart\" to restart the server.\n"))
  (let ([stop-server (run-server)])
    (display-usage)
    (let loop ([cmd (read)])
      (cond
        [(eof-object? cmd)
         (printf "Instaweb: Received EOF from input port. Will not read further.\n")
         (thread-wait (current-thread))]
        [(eq? cmd 'stop) (stop-server)]
        [(eq? cmd 'restart)
         (stop-server)
         (console-loop run-server)]
        [else (printf "Don't know what to do with ~s. Try again.\n" cmd)
              (display-usage)
              (loop (read))]))))

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

(provide instaweb
         instaweb/dispatcher
         run-server
         console-loop)