(in-package #:candle-cli)
-(defun main-options ()
- '((:name :help :short "h" :long "help" :description "Print this usage.")
- (:name :port :short "p" :long "port" :takes-argument t :variable-name "PORT"
- :description "Port on which to listen for commands. Defaults to 25004")
- (:positional "<command>" :required t :description "Command to send to candle server")))
-
-(defun project-options ()
- '((:name :help :short "h" :long "help" :description "Print this usage.")
- (:name :add :long "add" :takes-argument t :description
- "Add a project. NAME is the name of the project, which must not include colons, while SRC is the location of the repository for cloning. This location must be accessible by the machine running candle."
- :variable-name "NAME:SRC")
- (:name :show :long "show" :takes-argument t :description
- "Show branch information for a project named by NAME."
- :variable-name "NAME")
- (:name :refresh :long "refresh" :takes-argument t :description
- "Refresh project named by NAME."
- :variable-name "NAME")
- (:name :delete :long "delete" :takes-argument t :description
- "Delete a project named by NAME."
- :variable-name "NAME")))
-
-(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.")))
-
-(defun run-options ()
- '((:name :help :short "h" :long "help" :description "Print this usage.")))
-
-(defun main-usage ()
- (format t "~A"
- (opera:usage
- "candle"
- (main-options)
- "Interacts with candle server. The available commands are:
- project List, show or add projects
- job List or show jobs
- run Local command. Run candle in the current working directory")))
-
(defgeneric execute-command (command args))
(defmethod execute-command (command args)
(format *error-output* "Unknown command '~(~A~)'. See 'candle --help'.~%" command))
-(defun add-project (project-definition)
- (let
- ((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 (name)
- (communication:query `(candle:delete-project ,name))
- (format t "Removed project ~A~%" name))
-
(defun job-info->line (job-info)
(format nil "~A (~A) ~A"
(subseq (first job-info) 0 8)
- (format nil "~{~A/~A/~A ~A:~A~}"
+ (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)
(:succeeded (format nil "~c[1;32mPassed~c[0m" #\Esc #\Esc))
(:no-candle-file "No candle file present")
(:in-progress "In progress"))))
-(defun show-project (name)
- (let*
- ((branch-infos (communication:query `(candle:project-branch-information ,name)))
- (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 project-history (name)
- (format t "~{~A~%~}"
- (mapcar
- #'job-info->line
- (sort (communication:query `(candle:project-job-information ,name)) #'< :key #'third))))
-
-(defun refresh-project (name)
- (communication:query `(candle:refresh-project ,name))
- (format t "Refreshed project ~A~%" name))
+(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 ()
+ (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.")
+ (:name :port :short "p" :long "port" :takes-argument t :variable-name "PORT"
+ :description "Port on which to listen for commands. Defaults to 25004")
+ (:positional "<command>" :required t :description "Command for candle, see below")))
+
+(defun main-usage ()
+ (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) (format t "~A" (opera:usage "candle project" (project-options))))
- ((opera:option-present :delete options) (delete-project (opera:option-argument :delete options)))
- ((opera:option-present :show options) (show-project (opera:option-argument :show options)))
- ((opera:option-present :refresh options) (refresh-project (opera:option-argument :refresh options)))
- ((opera:option-present :add options) (add-project (opera:option-argument :add options))))))
+ (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 ()
+ (opera:usage
+ "candle project"
+ (project-options)
+ "Interacts with projects. The available project subcommands are:
+ list List all projects
+ add <name>:<src> Add a project
+ delete <name> Delete a project
+ show <name> Show project branch information
+ refresh <name> Tell the candle server to refresh the project information"))
+
+(defun project-options ()
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+ (:positional "<subcommand>" :description "Project subcommand, see below.")))
+
+(defun add-project (args)
+ (let
+ ((options
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+ (:positional "<name>:<src>" :description "<name> is the name of the project, which must be alphanumeric (hyphens are allowed), while <src> 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 "<name>:<src>"
+ (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 add --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
+ ((options
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+ (:positional "<name>" :description "<name> is the name of the project to delete"))))
+ (standard-cli "candle project delete" options args :default "<name>"
+ (communication:query `(candle:delete-project ,(car remaining-args)))
+ (format t "Removed project ~A~%" (car remaining-args)))))
+
+(defun show-project (args)
+ (let
+ ((options
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+ (:positional "<name>" :description "<name> is the name of the project to show"))))
+ (standard-cli "candle project show" options args :default "<name>"
+ (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
+ ((options
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+ (:positional "<name>" :description "<name> is the name of the project to refresh"))))
+ (standard-cli "candle project refresh" options args :default "<name>"
+ (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
+ ((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"))))
+ (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
(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))))
- ((not (opera:option-present :project-name options)) (format *error-output* "Requires --project argument. See 'candle job --help'.~%" ))
- (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)))))))
-(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 job-options ()
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+ (:positional "<subcommand>" :description "Job subcommand, see below.")))
+
+(defun job-usage ()
+ (opera:usage
+ "candle job"
+ (project-options)
+ "Interacts with projects. The available project subcommands are:
+ list List jobs
+ log <project>:<sha> View the log for a job
+ retry <project>:<sha> 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 #'third))))))
+
+(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 "<project>:<sha>" :description "<project> is the name of the project, while <sha> is the sha of the job in question."))))
+ (standard-cli "candle job log" options args :default "<project>:<sha>"
+ (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)))))))
+
+(defun retry-job (args)
+ (let
+ ((options
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+ (:positional "<project>:<sha>" :description "<project> is the name of the project, while <sha> is the sha of the job in question."))))
+ (standard-cli "candle job retry" options args :default "<project>:<sha>"
+ (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
-(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)))))))
+(defmethod execute-command ((command (eql :run)) args)
+ (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)))))
projects / candle / blobdiff