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

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