;;;
;;; Time-stamp: <2007-11-23 12:23:10 us>
;;;
;;; Copyright (C) 2005 by Noel Welsh.
;;;

;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.

;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.

;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA

;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:

(module instaweb mzscheme

  (require (lib "kw.ss")
           (lib "etc.ss")
           (lib "web-server.ss" "web-server"))

  (require (file "dispatcher.ss"))
  
  (provide instaweb
           instaweb-here

           make-dispatcher
           run-server
           console-loop)

  ;; syntax instaweb-here : servlet [port] [ip-address]
  (define-syntax instaweb-here
    (syntax-rules ()
      [(instaweb/here arg ...)
       (parameterize
         [(current-directory (this-expression-source-directory))]
         (instaweb arg ...))]))
    
  ;; instaweb : [#:port integer] [#listen-ip (U string #f)] [#:any any] ... -> void
  (define instaweb
    (lambda/kw (#:key [port 8765]
                      [listen-ip "127.0.0.1"]
                #:other-keys dispatch-args)
      (define (run-server-thunk)
        (run-server port listen-ip dispatch-args))
      (parameterize
          ([print-hash-table #t]
           [print-struct #t]
           [error-print-width 1024]
           [error-print-context-length 50])
        (console-loop run-server-thunk))))

  ;;; Utility functions ---------------------------------------------------

  ;; make-dispatcher : (listof any) -> dispatcher
  (define (make-dispatcher args)
    (apply make args))

  ;; run-server : integer (U string #f) (listof any) -> stop-server-thunk
  (define (run-server port listen-ip dispatcher-args)
    (begin0
        (serve #:dispatch (make-dispatcher dispatcher-args)
               #: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"))))

  ;; console-loop : ( -> 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 ~a.  Try again.\n" cmd)
               (display-usage)
               (loop (read))]))))
  
  )