X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Fcli.lisp;h=bacd1e3d62c7d15a6ede410728b02b0e84fb24a9;hb=d7f08bad7f5d32edb80f2e1468eff32c50166a94;hp=9e071afc95433a017a031e454c94c1b639722cd7;hpb=35c157ba73639931475862f37d3add1fa8513a0c;p=candle diff --git a/src/main/cli.lisp b/src/main/cli.lisp index 9e071af..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 --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 @@ -159,32 +182,71 @@ ;;; Section for ./candle job (defmethod execute-command ((command (eql :job)) args) - (multiple-value-bind (options remaining-args error) (opera:process-arguments (job-options) args) - (cond - ((eql error :unknown-option) (format *error-output* "Unknown option: ~A. See 'candle job --help'.~%" (car remaining-args))) - ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A. See 'candle job --help'.~%" (car remaining-args))) - ((opera:option-present :help options) (format t "~A" (opera:usage "candle job" (job-options) "Lists all jobs in PROJECT if no other action is specified"))) - ((not (opera:option-present :project-name options)) (format *error-output* "Requires --project argument. See 'candle job --help'.~%" )) - ((opera:option-present :log options) (job-log (opera:option-argument :project-name options) (opera:option-argument :log options))) - (t (project-history (opera:option-argument :project-name options)))))) + (standard-cli "candle job" (job-options) args (job-usage) nil + (let + ((subcommand (intern (string-upcase (car remaining-args)) :keyword))) + (case subcommand + (:list (job-list (cdr remaining-args))) + (:log (job-log (cdr remaining-args))) + (:retry (retry-job (cdr remaining-args))) + (t (format t "~A" (job-usage))))))) (defun job-options () '((:name :help :short "h" :long "help" :description "Print this usage.") - (:name :project-name :long "project" :takes-argument t - :variable-name "PROJECT" - :description "The project name for the jobs under consideration. Required argumnet.") - (:name :log :long "log" :takes-argument t - :variable-name "SHA" - :description "Show's the processing log for job at sha SHA. SHA can be truncated."))) - -(defun project-history (name) - (format t "~{~A~%~}" - (mapcar - #'job-info->line - (sort (communication:query `(candle:project-job-information ,name)) #'< :key #'third)))) + (:positional "" :description "Job subcommand, see below."))) -(defun job-log (project-name sha) - (format t "~A~%" (communication:query `(candle:get-job-log ,project-name ,sha)))) +(defun job-usage () + (opera:usage + "candle job" + (project-options) + "Interacts with projects. The available project subcommands are: + list List jobs + log : View the log for a job + retry : Retry a job")) + +(defun job-list (args) + (let + ((options + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:name :project :long "project" :variable-name "PROJECT" :takes-argument t :description "Restrict jobs to project named by PROJECT")))) + (standard-cli "candle job list" options args :default nil + (format t "~{~A~%~}" + (mapcar + #'job-info->line + (sort (communication:query `(candle:project-job-information ,(opera:option-argument :project parsed-options))) #'< :key #'fourth)))))) + +(defun decompose-job-definition (job-definition) + (let + ((pos (position #\: job-definition))) + (when + pos + (values + (subseq job-definition 0 pos) + (subseq job-definition (1+ pos)))))) + +(defun job-log (args) + (let + ((options + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:positional ":" :description " is the name of the project, while is the sha of the job in question.")))) + (standard-cli "candle job log" options args :default ":" + (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))) + (error-and-exit "Job definition ~A is not valid. See 'candle job log --help'.~%" (car remaining-args))))))) + +(defun retry-job (args) + (let + ((options + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:positional ":" :description " is the name of the project, while is the sha of the job in question.")))) + (standard-cli "candle job retry" options args :default ":" + (multiple-value-bind (project-name sha) (decompose-job-definition (car remaining-args)) + (if project-name + (progn + (communication:query `(candle:retry-job ,project-name ,sha)) + (format t "Retrying job ~A~%" (car remaining-args))) + (error-and-exit "Job definition ~A is not valid. See 'candle job log --help'.~%" (car remaining-args))))))) ;;; Section for ./candle run