;; 
;; %%HEADER%%
;;

(use chickumber args files posix chicken-syntax data-structures)
(cond-expand
  (development (load "chickumber.scm")
               (load "chickumber-server.scm")
               (import chickumber chickumber-server))
  (else        (use chickumber chickumber-server)))


(define supported-frameworks '(test boolean missbehave))
(define *verbosity* 0)

(args:width 30)

(define opts
  (list
   (args:make-option (h help) #:none "Show this help" (usage))
   (args:make-option (v verbose) #:none "Increase verbosity. Can be given multiple times. (overrides -q)" (set! *verbosity* (+ 1 *verbosity*)))
   (args:make-option (p port) (required: "PORT") (sprintf "port to bind on [default: ~A]" +default-port+))
   (args:make-option (f framework) (required: "FRAMEWORK") (sprintf "Testframework to use ~A" supported-frameworks))
   (args:make-option (q quiet) #:none "Disable all output")))

(define (usage)
  (with-output-to-port (current-error-port)
    (lambda ()
      (print "Usage: " (car (argv)) " [options] [stepfiles ...]")
      (newline)
      (print (args:usage opts))))
  (exit 1))

(define-syntax with-error-handling
  (syntax-rules ()
    ((_ code more-code ...)
     (let ((thunk (lambda () code more-code ...)))
       (condition-case (thunk)
         ((exn i/o net)
          (fprintf (current-error-port) "Could not bind. Is it already running?~%")
          (exit 1))
         (ex (exn i/o net timeout)
            (fprintf (current-error-port) "A network error accured: ~A~%" ((condition-property-accessor 'exn 'msg) ex))
            (exit 1))
         (ex
          (fprintf (current-error-port) "An error accured: ~A~%" ((condition-property-accessor 'exn 'msg) ex))
          (exit 1)))))))

;; todo add support for reloading of step-files
(define (main arguments)  
  (receive (options operands) (args:parse arguments opts)
    (let ((framework (string->symbol (or (alist-ref 'framework options) "boolean")))
          (port (string->number  (or (alist-ref 'port options) (number->string +default-port+))))
          (quiet (alist-ref 'quiet options)))
      
      (unless (member framework supported-frameworks)
        (usage))
        
      (unless quiet
        (printf "Starting chickumber at 127.0.0.1:~A with framework: ~A~%" port framework))
            
      (with-error-handling
       (start-wire-server
        operands
        debug: (>= *verbosity* 3)
        port: port
        framework: framework
        on-sig-hup: (lambda ()
                      (when (>= *verbosity* 1)
                          (printf "Reloading stepfiles ...~%")))
        on-shutdown: (lambda ()
                       (when (>= *verbosity* 1)
                         (printf "Shutting down ...~%"))
                       (exit 0)))))))


(main (command-line-arguments))