From: Frank Duncan Date: Thu, 16 Dec 2021 03:27:04 +0000 (-0600) Subject: Add job retry X-Git-Url: https://code.consxy.com/gitweb/?a=commitdiff_plain;h=b20fb177f8305dd8739d57c1bd832bd7a98ab25b;p=candle Add job retry --- diff --git a/src/main/cli.lisp b/src/main/cli.lisp index 4b56b16..fe36dfb 100644 --- a/src/main/cli.lisp +++ b/src/main/cli.lisp @@ -165,15 +165,8 @@ (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))))))) -; (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)))))) (defun job-options () '((:name :help :short "h" :long "help" :description "Print this usage.") @@ -184,8 +177,9 @@ "candle job" (project-options) "Interacts with projects. The available project subcommands are: - list List jobs - log : View the log for a job")) + list List jobs + log : View the log for a job + retry : Retry a job")) (defun job-list (args) (let @@ -218,6 +212,19 @@ (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))))))) +(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))) + (format *error-output* "Job definition ~A is not valid. See 'candle job log --help'.~%" (car remaining-args))))))) + ;;; Section for ./candle run (defmethod execute-command ((command (eql :run)) args) diff --git a/src/main/package.lisp b/src/main/package.lisp index 0f565c4..5e2263e 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -2,7 +2,7 @@ (:export #:server #:add-project #:delete-project #:refresh-project #:list-projects #:project-branch-information #:run #:*candle-dir* #:*job-system* #:*candle-dir* #:failures - #:project-job-information #:get-job-log #:job-project #:project-dir #:process-job-in-system)) + #:project-job-information #:get-job-log #:retry-job #:job-project #:project-dir #:process-job-in-system)) (defpackage #:candle-cli (:use :cl) (:export :run)) (defpackage #:candle-aws (:use :cl)) diff --git a/src/main/server.lisp b/src/main/server.lisp index 11edcce..19780e2 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -93,7 +93,7 @@ (find-job-by-project project) *all-job*)))) -(defun get-job-log (project-name sha) +(defun find-job-by-project-and-sha (project-name sha) (let* ((project (find project-name *all-project* :test #'string= :key #'project-name)) (job @@ -105,7 +105,14 @@ :key #'job-sha)))) (when (not project) (error "Project does not exist")) (when (not job) (error "Job does not exist")) - (job-log job))) + job)) + +(defun get-job-log (project-name sha) + (job-log (find-job-by-project-and-sha project-name sha))) + +(defun retry-job (project-name sha) + (set-job-status (find-job-by-project-and-sha project-name sha) :queued) + (awaken-processor-thread)) (defun list-projects () (mapcar