From: Frank Duncan Date: Wed, 15 Dec 2021 20:17:46 +0000 (-0600) Subject: Add project failures command X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=124e400cd0be0e884d0cb7ea400899b3288c1fc0;p=candle Add project failures command --- diff --git a/src/main/cli.lisp b/src/main/cli.lisp index c7a079e..d0a5c21 100644 --- a/src/main/cli.lisp +++ b/src/main/cli.lisp @@ -72,6 +72,7 @@ (:show (show-project (cdr remaining-args))) (:refresh (refresh-project (cdr remaining-args))) (:list (list-projects)) + (:failures (project-failures (cdr remaining-args))) (t (project-usage)))))))) (defun project-usage () @@ -173,6 +174,22 @@ (defun list-projects () (format t "~{~{~A ~A~}~%~}" (communication:query `(candle:list-projects)))) +(defun project-failures (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 failures to project named by PROJECT"))) + (usage (opera:usage "candle project failures" options))) + (multiple-value-bind (options remaining-args error) (opera:process-arguments options args) + (cond + ((eql error :unknown-option) (format *error-output* "Unknown option: ~A. See 'candle project failures --help'.~%" (car remaining-args))) + ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A. See 'candle project failures --help'.~%" (car remaining-args))) + ((opera:option-present :help options) (format t "~A" usage)) + (t + (format t "~A" + (communication:query + `(candle:failures ,(when (opera:option-present :project options) (opera:option-argument :project options)))))))))) + ;;; Section for ./candle job (defmethod execute-command ((command (eql :job)) args) diff --git a/src/main/package.lisp b/src/main/package.lisp index 848b09f..0f565c4 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -1,7 +1,7 @@ (defpackage #:candle (:use :cl) (:export #:server #:add-project #:delete-project #:refresh-project #:list-projects - #:project-branch-information #:run #:*candle-dir* #:*job-system* #:*candle-dir* + #: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)) (defpackage #:candle-cli (:use :cl) (:export :run)) diff --git a/src/main/server.lisp b/src/main/server.lisp index ef80743..f95976e 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -111,3 +111,12 @@ (project-name project) (project-src project))) *all-project*)) + +(defun failures (project-name) + (length + (remove-if-not + (lambda (branch) (eql :failed (job-status (branch-job branch)))) + (if project-name + (find-branch-by-project + (find project-name *all-project* :test #'string= :key #'project-name)) + *all-branch*))))