;; 
;; %%HEADER%%
;; 

(define (pretty-print-migration checkpoint irreversible? #!key (error #f) (message ""))
  (let ((direction (car checkpoint))
        (migration (cdr checkpoint)))
    (fmt #t
     (pad-char #\.
               (cat
                (fmt-bold (cat "[" (nomads:migration-version migration) "]"))
                (fmt-bold (cat "[" direction "] "))
                (filepath:drop-extension (nomads:migration-filename migration))
                " "
                (space-to 72)
                (fmt-bold (cond
                           (irreversible? (fmt-yellow " IRREVERSIBLE"))
                           (error (fmt-red " ERROR"))
                           (else  (fmt-green " OK"))))
                " " )))
    (when error
        (newline)
        (display  message)
        (newline))
    (newline)))

(define (run-migration cli-arguments)
  (let ((program-options
         (list
          (args:make-option (h help) #:none "Show this help")
          (args:make-option (u up) #:none "Migrate up. This is the default action.")
          (args:make-option (d down) #:none "Migrate down")
          (args:make-option (v version) #:required "The version you want to migrate to"))))
    (receive (options operands) (args:parse cli-arguments program-options)
      (cond
       ((assoc 'help options)
        (exit-with-message
         (with-output-to-string
           (lambda ()
             (print "Usage: nomads migrate")
             (newline)
             (print (args:usage program-options))))))
       ((assoc 'up options)
        (printf "Migrating UP~%~%")
        (nomads:migrate version: 'latest callback: pretty-print-migration))
       ((assoc 'down options)
        (printf "Migrating DOWN~%~%")
        (nomads:migrate version: 'earliest callback: pretty-print-migration))
       ((alist-ref 'version options)
        => (lambda (version)
             (printf "Migrating to Version: ~A~%~%" version)
             (nomads:migrate version: (string->number version) callback: pretty-print-migration)))
       (else
        (printf "Migrating UP~%~%")
        (nomads:migrate version: 'latest callback: pretty-print-migration))))))


(register-dispatch-target! 'migrate run-migration "Run the migrations")