code.consxy.com Git - candle/blob - src/main/cli.lisp

   1 (in-package #:candle-cli)
   2
   3 (defun main-options ()
   4  '((:name :help :short "h" :long "help" :description "Print this usage.")
   5    (:name :port :short "p" :long "port" :takes-argument t :variable-name "PORT"
   6     :description "Port on which to listen for commands.  Defaults to 25004")
   7    (:positional "<command>" :required t :description "Command to send to candle server")))
   8
   9 (defun project-options ()
  10  '((:name :help :short "h" :long "help" :description "Print this usage.")
  11    (:name :add :long "add" :takes-argument t :description
  12     "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."
  13     :variable-name "NAME:SRC")
  14    (:name :show :long "show" :takes-argument t :description
  15     "Show branch information for a project named by NAME."
  16     :variable-name "NAME")
  17    (:name :refresh :long "refresh" :takes-argument t :description
  18     "Refresh project named by NAME."
  19     :variable-name "NAME")
  20    (:name :delete :long "delete" :takes-argument t :description
  21     "Delete a project named by NAME."
  22     :variable-name "NAME")))
  23
  24 (defun job-options ()
  25  '((:name :help :short "h" :long "help" :description "Print this usage.")
  26    (:name :project-name :long "project" :takes-argument t
  27     :variable-name "PROJECT"
  28     :description "The project name for the jobs under consideration.  Required argumnet.")
  29    (:name :log :long "log" :takes-argument t
  30     :variable-name "SHA"
  31     :description "Show's the processing log for job at sha SHA.  SHA can be truncated.")))
  32
  33 (defun run-options ()
  34  '((:name :help :short "h" :long "help" :description "Print this usage.")))
  35
  36 (defun main-usage ()
  37  (format t "~A"
  38   (opera:usage
  39    "candle"
  40    (main-options)
  41    "Interacts with candle server.  The available commands are:
  42   project   List, show or add projects
  43   job       List or show jobs
  44   run       Local command.  Run candle in the current working directory")))
  45
  46 (defgeneric execute-command (command args))
  47
  48 (defmethod execute-command (command args)
  49  (format *error-output* "Unknown command '~(~A~)'.  See 'candle --help'.~%" command))
  50
  51 (defun add-project (project-definition)
  52  (let
  53   ((pos (position #\: project-definition)))
  54   (cond
  55    ((not pos) (format *error-output* "Project definition ~A is not valid.  See 'candle project --help'.~%" project-definition))
  56    (t
  57     (let*
  58      ((name (subseq project-definition 0 pos))
  59       (src (subseq project-definition (1+ pos))))
  60      (communication:query `(candle:add-project ,name ,src))
  61      (format t "Added project ~A at src definition ~A~%" name src))))))
  62
  63 (defun delete-project (name)
  64  (communication:query `(candle:delete-project ,name))
  65  (format t "Removed project ~A~%" name))
  66
  67 (defun job-info->line (job-info)
  68  (format nil "~A (~A) ~A"
  69   (subseq (first job-info) 0 8)
  70   (format nil "~{~A/~A/~A ~A:~A~}"
  71    (utils:time-as-list (third job-info) :month :date :year :hr :min))
  72   (case (second job-info)
  73    (:succeeded (format nil "~c[1;32mPassed~c[0m" #\Esc #\Esc))
  74    (:failed (format nil "~c[1;31mFailed~c[0m" #\Esc #\Esc))
  75    (:queued "In queue")
  76    (:no-candle-file "No candle file present")
  77    (:in-progress "In progress"))))
  78
  79 (defun show-project (name)
  80  (let*
  81   ((branch-infos (communication:query `(candle:project-branch-information ,name)))
  82    (width (apply #'max (mapcar #'length (mapcar #'car branch-infos)))))
  83   (mapcar
  84    (lambda (branch-info)
  85     (format t (format nil "~~~A@A: ~~A~~%" width)
  86      (first branch-info)
  87      (job-info->line (second branch-info))))
  88    (sort branch-infos #'< :key (lambda (branch-info) (third (second branch-info)))))))
  89
  90 (defun project-history (name)
  91  (format t "~{~A~%~}"
  92   (mapcar
  93    #'job-info->line
  94    (sort (communication:query `(candle:project-job-information ,name)) #'< :key #'third))))
  95
  96 (defun job-log (project-name sha)
  97  (format t "~A~%" (communication:query `(candle:get-job-log ,project-name ,sha))))
  98
  99 (defun refresh-project (name)
 100  (communication:query `(candle:refresh-project ,name))
 101  (format t "Refreshed project ~A~%" name))
 102
 103 (defmethod execute-command ((command (eql :project)) args)
 104  (multiple-value-bind (options remaining-args error) (opera:process-arguments (project-options) args)
 105   (cond
 106    ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle project --help'.~%" (car remaining-args)))
 107    ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle project --help'.~%" (car remaining-args)))
 108    ((opera:option-present :help options) (format t "~A" (opera:usage "candle project" (project-options))))
 109    ((opera:option-present :delete options) (delete-project (opera:option-argument :delete options)))
 110    ((opera:option-present :show options) (show-project (opera:option-argument :show options)))
 111    ((opera:option-present :refresh options) (refresh-project (opera:option-argument :refresh options)))
 112    ((opera:option-present :add options) (add-project (opera:option-argument :add options))))))
 113
 114 (defmethod execute-command ((command (eql :job)) args)
 115  (multiple-value-bind (options remaining-args error) (opera:process-arguments (job-options) args)
 116   (cond
 117    ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle job --help'.~%" (car remaining-args)))
 118    ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle job --help'.~%" (car remaining-args)))
 119    ((opera:option-present :help options) (format t "~A" (opera:usage "candle job" (job-options))))
 120    ((not (opera:option-present :project-name options)) (format *error-output* "Requires --project argument.  See 'candle job --help'.~%" ))
 121    ((opera:option-present :log options) (job-log (opera:option-argument :project-name options) (opera:option-argument :log options)))
 122    (t (project-history (opera:option-argument :project-name options))))))
 123
 124 (defmethod execute-command ((command (eql :run)) args)
 125  (multiple-value-bind (options remaining-args error) (opera:process-arguments (run-options) args)
 126   (cond
 127    ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle run --help'.~%" (car remaining-args)))
 128    ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle run --help'.~%" (car remaining-args)))
 129    (remaining-args (format *error-output* "Unknown option: ~A. See 'candle run --help'.~%" (car remaining-args)))
 130    ((opera:option-present :help options) (format t "~A" (opera:usage "candle run" (run-options))))
 131    ((not (candle:run)) (sb-ext:exit :code 1)))))
 132
 133 (defun run ()
 134  (multiple-value-bind (options remaining-args error) (opera:process-arguments (main-options) (cdr sb-ext:*posix-argv*))
 135   (cond
 136    ((opera:option-present :help options) (main-usage))
 137    ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle --help'.~%" (car remaining-args)))
 138    ((and (opera:option-present :port options) (not (parse-integer (opera:option-argument :port options) :junk-allowed t)))
 139     (format *error-output* "--port requires a number.  See 'candle-server -h'~%"))
 140    ((not remaining-args) (format *error-output* "Command required.  See 'candle --help'.~%"))
 141    (t
 142     (let
 143      ((communication:*query-port*
 144        (or
 145         (and
 146          (opera:option-present :port options)
 147          (parse-integer (opera:option-argument :port options) :junk-allowed t))
 148         25004)))
 149      (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args)))))))