X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Fcli.lisp;h=bacd1e3d62c7d15a6ede410728b02b0e84fb24a9;hb=d7f08bad7f5d32edb80f2e1468eff32c50166a94;hp=fe36dfbc1c775d83220fea82694430fa6a1c2804;hpb=b20fb177f8305dd8739d57c1bd832bd7a98ab25b;p=candle diff --git a/src/main/cli.lisp b/src/main/cli.lisp index fe36dfb..bacd1e3 100644 --- a/src/main/cli.lisp +++ b/src/main/cli.lisp @@ -2,15 +2,20 @@ (defgeneric execute-command (command args)) +(defun error-and-exit (str &rest args) + (apply #'format *error-output* str args) + (sb-ext:exit :code 1)) + (defmethod execute-command (command args) - (format *error-output* "Unknown command '~(~A~)'. See 'candle --help'.~%" command)) + (error-and-exit "Unknown command '~(~A~)'. See 'candle --help'.~%" command)) (defun job-info->line (job-info) - (format nil "~A (~A) ~A" - (subseq (first job-info) 0 8) + (format nil "~A:~A (~A) ~A" + (first job-info) + (subseq (second job-info) 0 8) (format nil "~{~2,,,'0@A/~2,,,'0@A/~A ~2,,,'0@A:~2,,,'0@A~}" - (utils:time-as-list (third job-info) :month :date :year :hr :min)) - (case (second job-info) + (utils:time-as-list (fourth job-info) :month :date :year :hr :min)) + (case (third job-info) (:succeeded (format nil "~c[1;32mPassed~c[0m" #\Esc #\Esc)) (:failed (format nil "~c[1;31mFailed~c[0m" #\Esc #\Esc)) (:queued "In queue") @@ -23,10 +28,11 @@ ((opera:option-present :help parsed-options) (format t "~A" ,(if (eql usage :default) `(opera:usage ,cmd ,options-in) usage))) ((eql error :unknown-option) - (format *error-output* "Unknown option: ~A. See '~A --help'.~%" (car remaining-args) ,cmd)) + (error-and-exit "Unknown option: ~A. See '~A --help'.~%" (car remaining-args) ,cmd)) ((eql error :required-argument-missing) - (format *error-output* "Missing argument for ~A. See '~A --help'.~%" (car remaining-args) ,cmd)) - ((and ,remaining-args-required (not remaining-args)) (format *error-output* "~A required. See 'candle --help'.~%" ,remaining-args-required)) + (error-and-exit "Missing argument for ~A. See '~A --help'.~%" (car remaining-args) ,cmd)) + ((and ,remaining-args-required (not remaining-args)) + (error-and-exit "~A required. See 'candle --help'.~%" ,remaining-args-required)) (t ,@success)))) @@ -34,17 +40,27 @@ (defun run () (standard-cli "candle" (main-options) (cdr sb-ext:*posix-argv*) (main-usage) "Command" - (if - (and (opera:option-present :port parsed-options) (not (parse-integer (opera:option-argument :port parsed-options) :junk-allowed t))) - (format *error-output* "--port requires a number. See 'candle -h'~%") - (let - ((communication:*query-port* - (or - (and - (opera:option-present :port parsed-options) - (parse-integer (opera:option-argument :port parsed-options) :junk-allowed t)) - 25004))) - (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args)))))) + (handler-case + (if + (and (opera:option-present :port parsed-options) (not (parse-integer (opera:option-argument :port parsed-options) :junk-allowed t))) + (error-and-exit "--port requires a number. See 'candle -h'~%") + (let + ((communication:*query-port* + (or + (and + (opera:option-present :port parsed-options) + (parse-integer (opera:option-argument :port parsed-options) :junk-allowed t)) + 25004))) + (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args)))) + (candle:candle-error (e) + (case (candle:candle-error-reason e) + (:project-does-not-exist (error-and-exit "Project does not exist~%")) + (:job-does-not-exist (error-and-exit "Job does not exist~%")) + (:invalid-project-name (error-and-exit "Project name invalid~%")) + (:invalid-project-uri (error-and-exit "Project uri invalid~%")) + (:project-name-taken (error-and-exit "Project name already taken~%")) + (:project-failed-to-get-branches (error-and-exit "Unable to retrieve branches from server~%")) + (t (error-and-exit "Unknown error occurred: ~(~S~)~%" (candle:candle-error-reason e)))))))) (defun main-options () '((:name :help :short "h" :long "help" :description "Print this usage.") @@ -101,7 +117,7 @@ ((project-definition (car remaining-args)) (pos (position #\: project-definition))) (cond - ((not pos) (format *error-output* "Project definition ~A is not valid. See 'candle project add --help'.~%" project-definition)) + ((not pos) (error-and-exit "Project definition ~A is not valid. See 'candle project add --help'.~%" project-definition)) (t (let* ((name (subseq project-definition 0 pos)) @@ -132,7 +148,7 @@ (format t (format nil "~~~A@A: ~~A~~%" width) (first branch-info) (job-info->line (second branch-info)))) - (sort branch-infos #'< :key (lambda (branch-info) (third (second branch-info))))))))) + (sort branch-infos #'< :key (lambda (branch-info) (fourth (second branch-info))))))))) (defun refresh-project (args) (let @@ -144,7 +160,14 @@ (format t "Refreshed project ~A~%" (car remaining-args))))) (defun list-projects () - (format t "~{~{~A ~A~}~%~}" (communication:query `(candle:list-projects)))) + (format t "~{~A~%~}" + (mapcar + (lambda (info) + (format nil "~A ~A~A" + (car info) + (cadr info) + (if (zerop (caddr info)) "" (format nil " (~A branches ~c[1;31mfailing~c[0m)" (caddr info) #\Esc #\Esc)))) + (communication:query `(candle:list-projects))))) (defun project-failures (args) (let @@ -190,7 +213,7 @@ (format t "~{~A~%~}" (mapcar #'job-info->line - (sort (communication:query `(candle:project-job-information ,(opera:option-argument :project parsed-options))) #'< :key #'third)))))) + (sort (communication:query `(candle:project-job-information ,(opera:option-argument :project parsed-options))) #'< :key #'fourth)))))) (defun decompose-job-definition (job-definition) (let @@ -210,7 +233,7 @@ (multiple-value-bind (project-name sha) (decompose-job-definition (car remaining-args)) (if project-name (format t "~A" (communication:query `(candle:get-job-log ,project-name ,sha))) - (format *error-output* "Job definition ~A is not valid. See 'candle job log --help'.~%" (car remaining-args))))))) + (error-and-exit "Job definition ~A is not valid. See 'candle job log --help'.~%" (car remaining-args))))))) (defun retry-job (args) (let @@ -223,7 +246,7 @@ (progn (communication:query `(candle:retry-job ,project-name ,sha)) (format t "Retrying job ~A~%" (car remaining-args))) - (format *error-output* "Job definition ~A is not valid. See 'candle job log --help'.~%" (car remaining-args))))))) + (error-and-exit "Job definition ~A is not valid. See 'candle job log --help'.~%" (car remaining-args))))))) ;;; Section for ./candle run