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) ~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   (standard-cli "candle run" options args :default nil
 276    (cond
 277     ((opera:option-present :task parsed-options)
 278      (let
 279       ((tasks (candle:list-tasks))
 280        (specified-task (intern (string-upcase (opera:option-argument :task parsed-options)) :keyword)))
 281       (if
 282        (not (find specified-task (candle:list-tasks)))
 283        (error-and-exit "Task ~(~A~) does not exist in .candle file" specified-task)
 284        (candle:run specified-task))))
 285     (t (when (not (candle:run)) (sb-ext:exit :code 1)))))))