;; Author: David Krentzlin <david@lisp-unleashed.de>
;; Copyright (c) 2011 David Krentzlin <david@lisp-unleashed.de>
;; 
;;   Permission is hereby granted, free of charge, to any person
;;   obtaining a copy of this software and associated documentation
;;   files (the "Software"), to deal in the Software without
;;   restriction, including without limitation the rights to use,
;;   copy, modify, merge, publish, distribute, sublicense, and/or sell
;;   copies of the Software, and to permit persons to whom the
;;   Software is furnished to do so, subject to the following
;;   conditions:
;; 
;;   The above copyright notice and this permission notice shall be
;;   included in all copies or substantial portions of the Software.
;; 
;;   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;;   OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;   NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;   HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;   WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;;   FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;;   OTHER DEALINGS IN THE SOFTWARE.
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(use args srfi-1 filepath simple-configuration srfi-69 ports files defstruct fmt fmt-color (prefix nomads nomads:))

(include "nomads-cli-ui.scm")

;; Handle submodules

(define *dispatch-table* (make-hash-table))

(define (register-dispatch-target! key value #!optional (documentation ""))
  (set! (hash-table-ref *dispatch-table* key) (cons value documentation)))

(define (dispatch-targets)
  (hash-table-keys *dispatch-table*))

(define (dispatch-target-ref key)
  (car  (hash-table-ref/default *dispatch-table* key (list #f))))

(define (module-called? operands)
  (and (not (null? operands))
       (dispatch-target-ref (string->symbol (car operands)))))

(define (dispatch-command command parsed-options arguments)
  (let ((handler (dispatch-target-ref (string->symbol command))))
    (unless handler
      (exit-with-message (sprintf  "Unsupported command. Must be one of ~A" (dispatch-targets)) 1))

    (configure-nomads parsed-options)
    (exit (if (handler arguments) 0 1))))

;; Main

(define program-options
  (list (args:make-option (c configfile) #:required "path to the configuration. Default ./nomads.config")
        (args:make-option (h help) #:none  "Display this help")))

(define (run-cli)
  (receive (options operands)  (args:parse (command-line-arguments) program-options #:unrecognized-proc args:ignore-unrecognized-options) 
    (cond
     ((module-called? operands)
      (dispatch-command (car operands) options (cdr (command-line-arguments))))
     ((alist-ref 'help options)
      (exit-with-message (usage)))
     (else (exit-with-message (usage) 1)))))

(define (configure-nomads options)
  (configure-timestamped-migrations)
  
  (let ((config-file (absolutize-path (or (alist-ref 'c options) "nomads.config"))))
    
    (unless (file-exists? config-file)
      (exit-with-message (sprintf "The configuration file ~A does not exist. Please create one." config-file) 1))

    (let ((configuration (config-read config-file)))
      (config-let configuration ((migration-directory (nomads  migration-directory))
                                 (adapter             (nomads database adapter))
                                 (db-credentials      (nomads database credentials)))
                  (case adapter
                   ((sqlite) (use nomads-sql-de-lite))
                   ((postgres) (use nomads-postgresql))
                   (else
                    (exit-with-message "Invalid adapter specified. Must be either sqlite or postgres." 1)))
                  
                  (nomads:migration-directory migration-directory)
                  (nomads:database-credentials db-credentials)))))


(include "nomads-cli-timestamped.scm")
(include "nomads-cli-migration.scm")
(include "nomads-cli-generation.scm")

(define (exit-with-message message #!optional (exit-code 0))
  (with-output-to-port (if (zero? exit-code) (current-output-port) (current-error-port))
    (lambda ()
      (print message)
      (exit exit-code))))


(define (symbol< lhs rhs)
  (string< (symbol->string lhs) (symbol->string rhs)))

(define (command-help)
  (string-join
   (map
    (lambda (key)
      (let ((documentation (cdr (hash-table-ref/default *dispatch-table* key '("" . "")))))
        (sprintf "  ~A\t\t~A" key documentation)))
    (sort (hash-table-keys *dispatch-table*) symbol<))
   "\n"))

(define (usage)
  (with-output-to-string
    (lambda ()
      (print "Usage: " (pathname-file (car (argv))) " [options] command [options] ")
      (newline)
      (print "Options")
      (print "=======")
      (print (args:usage program-options))
      (printf "Commands~%========~%~A" (command-help))
      (newline))))

(define (absolutize-path path)
  (let ((cwd (current-directory)))
    (if (absolute-pathname? path)
        (normalize-pathname path)
        (normalize-pathname (conc cwd "/" path)))))

(run-cli)