697fb42a5e333e9b04e7fe7dff09ecfdede4b60f
[candle] / src / main / cli.lisp
1 (in-package #:candle-cli)
2
3 (defgeneric execute-command (command args))
4
5 (defun error-and-exit (str &rest args)
6  (apply #'format *error-output* str args)
7  (sb-ext:exit :code 1))
8
9 (defmethod execute-command (command args)
10  (error-and-exit "Unknown command '~(~A~)'.  See 'candle --help'.~%" command))
11
12 (defun job-info->line (job-info)
13  (format nil "~A:~A (~A) ~A"
14   (first job-info)
15   (subseq (second job-info) 0 8)
16   (format nil "~{~2,,,'0@A/~2,,,'0@A/~A ~2,,,'0@A:~2,,,'0@A~}"
17    (utils:time-as-list (fourth job-info) :month :date :year :hr :min))
18   (case (third job-info)
19    (:succeeded (format nil "~c[1;32mPassed~c[0m" #\Esc #\Esc))
20    (:failed (format nil "~c[1;31mFailed~c[0m" #\Esc #\Esc))
21    (:queued "In queue")
22    (:no-candle-file "No candle file present")
23    (:in-progress "In progress"))))
24
25 (defmacro standard-cli (cmd options-in args usage remaining-args-required &rest success)
26  `(multiple-value-bind (parsed-options remaining-args error) (opera:process-arguments ,options-in ,args)
27    (cond
28     ((opera:option-present :help parsed-options)
29      (format t "~A" ,(if (eql usage :default) `(opera:usage ,cmd ,options-in) usage)))
30     ((eql error :unknown-option)
31      (error-and-exit "Unknown option: ~A.  See '~A --help'.~%" (car remaining-args) ,cmd))
32     ((eql error :required-argument-missing)
33      (error-and-exit "Missing argument for ~A.  See '~A --help'.~%" (car remaining-args) ,cmd))
34     ((and ,remaining-args-required (not remaining-args))
35      (error-and-exit "~A required.  See 'candle --help'.~%" ,remaining-args-required))
36     (t
37      ,@success))))
38
39 ;;; Section for ./candle
40
41 (defun run ()
42  (standard-cli "candle" (main-options) (cdr sb-ext:*posix-argv*) (main-usage) "Command"
43   (handler-case
44    (if
45     (and
46      (opera:option-present :port parsed-options)
47      (not (parse-integer (opera:option-argument :port parsed-options) :junk-allowed t)))
48     (error-and-exit "--port requires a number.  See 'candle -h'~%")
49     (let
50      ((communication:*query-port*
51        (or
52         (and
53          (opera:option-present :port parsed-options)
54          (parse-integer (opera:option-argument :port parsed-options) :junk-allowed t))
55         25004)))
56      (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args))))
57    (candle:candle-error (e)
58     (case (candle:candle-error-reason e)
59      (:project-does-not-exist (error-and-exit "Project does not exist~%"))
60      (:job-does-not-exist (error-and-exit "Job does not exist~%"))
61      (:invalid-project-name (error-and-exit "Project name invalid~%"))
62      (:invalid-project-uri (error-and-exit "Project uri invalid~%"))
63      (:project-name-taken (error-and-exit "Project name already taken~%"))
64      (:project-failed-to-get-branches (error-and-exit "Unable to retrieve branches from server~%"))
65      (t (error-and-exit "Unknown error occurred: ~(~S~)~%" (candle:candle-error-reason e))))))))
66
67 (defun main-options ()
68  '((:name :help :short "h" :long "help" :description "Print this usage.")
69    (:name :port :short "p" :long "port" :takes-argument t :variable-name "PORT"
70     :description "Port on which to listen for commands.  Defaults to 25004")
71    (:positional "<command>" :required t :description "Command for candle, see below")))
72
73 (defun main-usage ()
74  (opera:usage
75   "candle"
76   (main-options)
77   "Interacts with candle server.  The available commands are:
78  project   Interact with projects
79  job       Get information about jobs
80  run       Local command.  Run candle in the current working directory"))
81
82 ;;; Section for ./candle project
83
84 (defmethod execute-command ((command (eql :project)) args)
85  (standard-cli "candle project" (project-options) args (project-usage) nil
86   (let
87    ((subcommand (intern (string-upcase (car remaining-args)) :keyword)))
88    (case subcommand
89     (:delete (delete-project (cdr remaining-args)))
90     (:add (add-project (cdr remaining-args)))
91     (:show (show-project (cdr remaining-args)))
92     (:refresh (refresh-project (cdr remaining-args)))
93     (:list (list-projects))
94     (:failures (project-failures (cdr remaining-args)))
95     (t (format t "~A" (project-usage)))))))
96
97 (defun project-usage ()
98  (opera:usage
99   "candle project"
100   (project-options)
101   "Interacts with projects.  The available project subcommands are:
102  list              List all projects
103  add <name>:<src>  Add a project
104  delete <name>     Delete a project
105  show <name>       Show project branch information
106  refresh <name>    Tell the candle server to refresh the project information"))
107
108 (defun project-options ()
109  '((:name :help :short "h" :long "help" :description "Print this usage.")
110    (:positional "<subcommand>" :description "Project subcommand, see below.")))
111
112 (defun add-project (args)
113  (let
114   ((options
115     `((:name :help :short "h" :long "help" :description "Print this usage.")
116       (:positional "<name>:<src>"
117        :description
118        ,(format nil "~{~A~}"
119          (list
120           "<name> is the name of the project, which must be alphanumeric (hyphens are allowed), while <src> is the "
121           "location of the repository for cloning.  This location must be accessible by the machine running candle."
122           ""))))))
123   (standard-cli "candle project add" options args :default "<name>:<src>"
124    (let*
125     ((project-definition (car remaining-args))
126      (pos (position #\: project-definition)))
127     (cond
128      ((not pos)
129       (error-and-exit "Project definition ~A is not valid.  See 'candle project add --help'.~%" project-definition))
130      (t
131       (let*
132        ((name (subseq project-definition 0 pos))
133         (src (subseq project-definition (1+ pos))))
134        (communication:query `(candle:add-project ,name ,src))
135        (format t "Added project ~A at src definition ~A~%" name src))))))))
136
137 (defun delete-project (args)
138  (let
139   ((options
140     '((:name :help :short "h" :long "help" :description "Print this usage.")
141       (:positional "<name>" :description "<name> is the name of the project to delete"))))
142   (standard-cli "candle project delete" options args :default "<name>"
143    (communication:query `(candle:delete-project ,(car remaining-args)))
144    (format t "Removed project ~A~%" (car remaining-args)))))
145
146 (defun show-project (args)
147  (let
148   ((options
149     '((:name :help :short "h" :long "help" :description "Print this usage.")
150       (:positional "<name>" :description "<name> is the name of the project to show"))))
151   (standard-cli "candle project show" options args :default "<name>"
152    (let*
153     ((branch-infos (communication:query `(candle:project-branch-information ,(car remaining-args))))
154      (width (apply #'max (mapcar #'length (mapcar #'car branch-infos)))))
155     (mapcar
156      (lambda (branch-info)
157       (format t (format nil "~~~A@A: ~~A~~%" width)
158        (first branch-info)
159        (job-info->line (second branch-info))))
160      (sort branch-infos #'< :key (lambda (branch-info) (fourth (second branch-info)))))))))
161
162 (defun refresh-project (args)
163  (let
164   ((options
165     '((:name :help :short "h" :long "help" :description "Print this usage.")
166       (:positional "<name>" :description "<name> is the name of the project to refresh"))))
167   (standard-cli "candle project refresh" options args :default "<name>"
168    (communication:query `(candle:refresh-project ,(car remaining-args)))
169    (format t "Refreshed project ~A~%" (car remaining-args)))))
170
171 (defun list-projects ()
172  (format t "~{~A~%~}"
173   (mapcar
174    (lambda (info)
175     (format nil "~A  ~A~A"
176      (car info)
177      (cadr info)
178      (if (zerop (caddr info)) "" (format nil " (~A branches ~c[1;31mfailing~c[0m)" (caddr info) #\Esc #\Esc))))
179    (communication:query `(candle:list-projects)))))
180
181 (defun project-failures (args)
182  (let
183   ((options
184     '((:name :help :short "h" :long "help" :description "Print this usage.")
185       (:name :project :long "project" :variable-name "PROJECT" :takes-argument t
186        :description "Restrict failures to project named by PROJECT"))))
187   (standard-cli "candle project failures" options args :default nil
188    (format t "~A"
189     (communication:query
190      `(candle:failures
191        ,(when (opera:option-present :project parsed-options)
192          (opera:option-argument :project parsed-options))))))))
193
194 ;;; Section for ./candle job
195
196 (defmethod execute-command ((command (eql :job)) args)
197  (standard-cli "candle job" (job-options) args (job-usage) nil
198   (let
199    ((subcommand (intern (string-upcase (car remaining-args)) :keyword)))
200    (case subcommand
201     (:list (job-list (cdr remaining-args)))
202     (:log (job-log (cdr remaining-args)))
203     (:retry (retry-job (cdr remaining-args)))
204     (t (format t "~A" (job-usage)))))))
205
206 (defun job-options ()
207  '((:name :help :short "h" :long "help" :description "Print this usage.")
208    (:positional "<subcommand>" :description "Job subcommand, see below.")))
209
210 (defun job-usage ()
211  (opera:usage
212   "candle job"
213   (project-options)
214   "Interacts with projects.  The available project subcommands are:
215  list                   List jobs
216  log <project>:<sha>    View the log for a job
217  retry <project>:<sha>  Retry a job"))
218
219 (defun job-list (args)
220  (let
221   ((options
222     '((:name :help :short "h" :long "help" :description "Print this usage.")
223       (:name :project :long "project" :variable-name "PROJECT" :takes-argument t
224        :description "Restrict jobs to project named by PROJECT"))))
225   (standard-cli "candle job list" options args :default nil
226    (format t "~{~A~%~}"
227     (mapcar
228      #'job-info->line
229      (sort
230       (communication:query `(candle:project-job-information ,(opera:option-argument :project parsed-options)))
231       #'< :key #'fourth))))))
232
233 (defun decompose-job-definition (job-definition)
234  (let
235   ((pos (position #\: job-definition)))
236   (when
237    pos
238    (values
239     (subseq job-definition 0 pos)
240     (subseq job-definition (1+ pos))))))
241
242 (defun job-log (args)
243  (let
244   ((options
245     '((:name :help :short "h" :long "help" :description "Print this usage.")
246       (:positional "<project>:<sha>"
247        :description "<project> is the name of the project, while <sha> is the sha of the job in question."))))
248   (standard-cli "candle job log" options args :default "<project>:<sha>"
249    (multiple-value-bind (project-name sha) (decompose-job-definition (car remaining-args))
250     (if project-name
251      (format t "~A" (communication:query `(candle:get-job-log ,project-name ,sha)))
252      (error-and-exit "Job definition ~A is not valid.  See 'candle job log --help'.~%" (car remaining-args)))))))
253
254 (defun retry-job (args)
255  (let
256   ((options
257     '((:name :help :short "h" :long "help" :description "Print this usage.")
258       (:positional "<project>:<sha>"
259        :description "<project> is the name of the project, while <sha> is the sha of the job in question."))))
260   (standard-cli "candle job retry" options args :default "<project>:<sha>"
261    (multiple-value-bind (project-name sha) (decompose-job-definition (car remaining-args))
262     (if project-name
263      (progn
264       (communication:query `(candle:retry-job ,project-name ,sha))
265       (format t "Retrying job ~A~%" (car remaining-args)))
266      (error-and-exit "Job definition ~A is not valid.  See 'candle job log --help'.~%" (car remaining-args)))))))
267
268 ;;; Section for ./candle run
269
270 (defmethod execute-command ((command (eql :run)) args)
271  (let
272   ((options
273     '((:name :help :short "h" :long "help" :description "Print this usage.")
274       (:name :task :long "task" :variable-name "TASK" :takes-argument t :description "Run TASK")
275       (:name :env :long "env" :variable-name "ENV" :takes-argument t
276        :description "Runs candle with *candle-environment* set to ENV as a keyword."))))
277   (standard-cli "candle run" options args :default nil
278    (when (opera:option-present :env parsed-options)
279     (setf candle:*environment* (intern (string-upcase (opera:option-argument :env parsed-options)) :keyword)))
280    (cond
281     ((opera:option-present :task parsed-options)
282      (let
283       ((tasks (candle:list-tasks))
284        (specified-task (intern (string-upcase (opera:option-argument :task parsed-options)) :keyword)))
285       (if
286        (not (find specified-task (candle:list-tasks)))
287        (error-and-exit "Task ~(~A~) does not exist in .candle file" specified-task)
288        (candle:run specified-task))))
289     (t (when (not (candle:run)) (sb-ext:exit :code 1)))))))