From: Frank Duncan Date: Wed, 15 Dec 2021 21:34:37 +0000 (-0600) Subject: Refactor project cli X-Git-Url: https://code.consxy.com/gitweb/?a=commitdiff_plain;h=35c157ba73639931475862f37d3add1fa8513a0c;p=candle Refactor project cli --- diff --git a/src/main/cli.lisp b/src/main/cli.lisp index d0a5c21..9e071af 100644 --- a/src/main/cli.lisp +++ b/src/main/cli.lisp @@ -17,25 +17,34 @@ (:no-candle-file "No candle file present") (:in-progress "In progress")))) +(defmacro standard-cli (cmd options-in args usage remaining-args-required &rest success) +`(multiple-value-bind (parsed-options remaining-args error) (opera:process-arguments ,options-in ,args) + (cond + ((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)) + ((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)) + (t + ,@success)))) + ;;; Section for ./candle (defun run () - (multiple-value-bind (options remaining-args error) (opera:process-arguments (main-options) (cdr sb-ext:*posix-argv*)) - (cond - ((opera:option-present :help options) (main-usage)) - ((eql error :unknown-option) (format *error-output* "Unknown option: ~A. See 'candle --help'.~%" (car remaining-args))) - ((and (opera:option-present :port options) (not (parse-integer (opera:option-argument :port options) :junk-allowed t))) - (format *error-output* "--port requires a number. See 'candle-server -h'~%")) - ((not remaining-args) (format *error-output* "Command required. See 'candle --help'.~%")) - (t - (let - ((communication:*query-port* - (or - (and - (opera:option-present :port options) - (parse-integer (opera:option-argument :port options) :junk-allowed t)) - 25004))) - (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args))))))) + (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)))))) (defun main-options () '((:name :help :short "h" :long "help" :description "Print this usage.") @@ -44,151 +53,108 @@ (:positional "" :required t :description "Command for candle, see below"))) (defun main-usage () - (format t "~A" - (opera:usage - "candle" - (main-options) - "Interacts with candle server. The available commands are: - project Interact with projects - job Get information about jobs - run Local command. Run candle in the current working directory"))) + (opera:usage + "candle" + (main-options) + "Interacts with candle server. The available commands are: + project Interact with projects + job Get information about jobs + run Local command. Run candle in the current working directory")) ;;; Section for ./candle project (defmethod execute-command ((command (eql :project)) args) - (multiple-value-bind (options remaining-args error) (opera:process-arguments (project-options) args) - (cond - ((eql error :unknown-option) - (format *error-output* "Unknown option: ~A. See 'candle project --help'.~%" (car remaining-args))) - ((eql error :required-argument-missing) - (format *error-output* "Missing argument for ~A. See 'candle project --help'.~%" (car remaining-args))) - ((opera:option-present :help options) (project-usage)) - (t - (let - ((subcommand (intern (string-upcase (car remaining-args)) :keyword))) - (case subcommand - (:delete (delete-project (cdr remaining-args))) - (:add (add-project (cdr remaining-args))) - (:show (show-project (cdr remaining-args))) - (:refresh (refresh-project (cdr remaining-args))) - (:list (list-projects)) - (:failures (project-failures (cdr remaining-args))) - (t (project-usage)))))))) + (standard-cli "candle project" (project-options) args (project-usage) nil + (let + ((subcommand (intern (string-upcase (car remaining-args)) :keyword))) + (case subcommand + (:delete (delete-project (cdr remaining-args))) + (:add (add-project (cdr remaining-args))) + (:show (show-project (cdr remaining-args))) + (:refresh (refresh-project (cdr remaining-args))) + (:list (list-projects)) + (:failures (project-failures (cdr remaining-args))) + (t (format t "~A" (project-usage))))))) (defun project-usage () - (format t "~A" - (opera:usage - "candle project" - (project-options) - "Interacts with projects. The available project subcommands are: - list List all projects - add : Add a project - delete Delete a project - show Show project branch information - refresh Tell the candle server to refresh the project information"))) + (opera:usage + "candle project" + (project-options) + "Interacts with projects. The available project subcommands are: + list List all projects + add : Add a project + delete Delete a project + show Show project branch information + refresh Tell the candle server to refresh the project information")) (defun project-options () '((:name :help :short "h" :long "help" :description "Print this usage.") (:positional "" :description "Project subcommand, see below."))) (defun add-project (args) - (let* + (let ((options '((:name :help :short "h" :long "help" :description "Print this usage.") - (:positional ":" :description " is the name of the project, which must be alphanumeric (hyphens are allowed), while is the location of the repository for cloning. This location must be accessible by the machine running candle."))) - (usage (opera:usage "candle project add" 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 add --help'.~%" (car remaining-args))) - ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A. See 'candle project add --help'.~%" (car remaining-args))) - ((opera:option-present :help options) (format t "~A" usage)) - ((not remaining-args) (format *error-output* "Required :. See 'candle project add --help'.~%")) - (t - (let* - ((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)) - (t - (let* - ((name (subseq project-definition 0 pos)) - (src (subseq project-definition (1+ pos)))) - (communication:query `(candle:add-project ,name ,src)) - (format t "Added project ~A at src definition ~A~%" name src)))))))))) + (:positional ":" :description " is the name of the project, which must be alphanumeric (hyphens are allowed), while is the location of the repository for cloning. This location must be accessible by the machine running candle.")))) + (standard-cli "candle project add" options args :default ":" + (let* + ((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)) + (t + (let* + ((name (subseq project-definition 0 pos)) + (src (subseq project-definition (1+ pos)))) + (communication:query `(candle:add-project ,name ,src)) + (format t "Added project ~A at src definition ~A~%" name src)))))))) (defun delete-project (args) - (let* + (let ((options '((:name :help :short "h" :long "help" :description "Print this usage.") - (:positional "" :description " is the name of the project to delete"))) - (usage (opera:usage "candle project delete" 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 delete --help'.~%" (car remaining-args))) - ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A. See 'candle project delete --help'.~%" (car remaining-args))) - ((opera:option-present :help options) (format t "~A" usage)) - ((not remaining-args) (format *error-output* "Required . See 'candle project delete --help'.~%")) - (t - (communication:query `(candle:delete-project ,(car remaining-args))) - (format t "Removed project ~A~%" (car remaining-args))))))) + (:positional "" :description " is the name of the project to delete")))) + (standard-cli "candle project delete" options args :default "" + (communication:query `(candle:delete-project ,(car remaining-args))) + (format t "Removed project ~A~%" (car remaining-args))))) (defun show-project (args) - (let* + (let ((options '((:name :help :short "h" :long "help" :description "Print this usage.") - (:positional "" :description " is the name of the project to show"))) - (usage (opera:usage "candle project delete" 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 show --help'.~%" (car remaining-args))) - ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A. See 'candle project show --help'.~%" (car remaining-args))) - ((opera:option-present :help options) (format t "~A" usage)) - ((not remaining-args) (format *error-output* "Required . See 'candle project show --help'.~%")) - (t - (let* - ((branch-infos (communication:query `(candle:project-branch-information ,(car remaining-args)))) - (width (apply #'max (mapcar #'length (mapcar #'car branch-infos))))) - (mapcar - (lambda (branch-info) - (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))))))))))) + (:positional "" :description " is the name of the project to show")))) + (standard-cli "candle project show" options args :default "" + (let* + ((branch-infos (communication:query `(candle:project-branch-information ,(car remaining-args)))) + (width (apply #'max (mapcar #'length (mapcar #'car branch-infos))))) + (mapcar + (lambda (branch-info) + (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))))))))) (defun refresh-project (args) - (let* + (let ((options '((:name :help :short "h" :long "help" :description "Print this usage.") - (:positional "" :description " is the name of the project to refresh"))) - (usage (opera:usage "candle project refresh" 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 refresh --help'.~%" (car remaining-args))) - ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A. See 'candle project refresh --help'.~%" (car remaining-args))) - ((opera:option-present :help options) (format t "~A" usage)) - ((not remaining-args) (format *error-output* "Required . See 'candle project refresh --help'.~%")) - (t - (communication:query `(candle:refresh-project ,(car remaining-args))) - (format t "Refreshed project ~A~%" (car remaining-args))))))) + (:positional "" :description " is the name of the project to refresh")))) + (standard-cli "candle project refresh" options args :default "" + (communication:query `(candle:refresh-project ,(car remaining-args))) + (format t "Refreshed project ~A~%" (car remaining-args))))) (defun list-projects () (format t "~{~{~A ~A~}~%~}" (communication:query `(candle:list-projects)))) (defun project-failures (args) - (let* + (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)))))))))) + (:name :project :long "project" :variable-name "PROJECT" :takes-argument t :description "Restrict failures to project named by PROJECT")))) + (standard-cli "candle project failures" options args :default nil + (format t "~A" + (communication:query + `(candle:failures ,(when (opera:option-present :project parsed-options) (opera:option-argument :project parsed-options)))))))) ;;; Section for ./candle job @@ -223,13 +189,7 @@ ;;; Section for ./candle run (defmethod execute-command ((command (eql :run)) args) - (multiple-value-bind (options remaining-args error) (opera:process-arguments (run-options) args) - (cond - ((eql error :unknown-option) (format *error-output* "Unknown option: ~A. See 'candle run --help'.~%" (car remaining-args))) - ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A. See 'candle run --help'.~%" (car remaining-args))) - (remaining-args (format *error-output* "Unknown option: ~A. See 'candle run --help'.~%" (car remaining-args))) - ((opera:option-present :help options) (format t "~A" (opera:usage "candle run" (run-options)))) - ((not (candle:run)) (sb-ext:exit :code 1))))) - -(defun run-options () - '((:name :help :short "h" :long "help" :description "Print this usage."))) + (let + ((options '((:name :help :short "h" :long "help" :description "Print this usage.")))) + (standard-cli "run" options args :default nil + (when (not (candle:run)) (sb-ext:exit :code 1)))))