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