Change project options in subcommands, refactor cli
authorFrank Duncan <frank@kank.net>
Sun, 12 Dec 2021 17:19:36 +0000 (11:19 -0600)
committerFrank Duncan <frank@kank.net>
Sun, 12 Dec 2021 17:19:36 +0000 (11:19 -0600)
src/main/cli.lisp

index ee917b3c98e1acb9bb9f881a72b9770d5f1860b8..c1f013bf395e225bba08c3ca08e582fc3bc39d4c 100644 (file)
@@ -1,69 +1,10 @@
 (in-package #:candle-cli)
 
-(defun main-options ()
- '((:name :help :short "h" :long "help" :description "Print this usage.")
-   (:name :port :short "p" :long "port" :takes-argument t :variable-name "PORT"
-    :description "Port on which to listen for commands.  Defaults to 25004")
-   (:positional "<command>" :required t :description "Command to send to candle server")))
-
-(defun project-options ()
- '((:name :help :short "h" :long "help" :description "Print this usage.")
-   (:name :add :long "add" :takes-argument t :description
-    "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."
-    :variable-name "NAME:SRC")
-   (:name :show :long "show" :takes-argument t :description
-    "Show branch information for a project named by NAME."
-    :variable-name "NAME")
-   (:name :refresh :long "refresh" :takes-argument t :description
-    "Refresh project named by NAME."
-    :variable-name "NAME")
-   (:name :delete :long "delete" :takes-argument t :description
-    "Delete a project named by NAME."
-    :variable-name "NAME")))
-
-(defun job-options ()
- '((:name :help :short "h" :long "help" :description "Print this usage.")
-   (:name :project-name :long "project" :takes-argument t
-    :variable-name "PROJECT"
-    :description "The project name for the jobs under consideration.  Required argumnet.")
-   (:name :log :long "log" :takes-argument t
-    :variable-name "SHA"
-    :description "Show's the processing log for job at sha SHA.  SHA can be truncated.")))
-
-(defun run-options ()
- '((:name :help :short "h" :long "help" :description "Print this usage.")))
-
-(defun main-usage ()
- (format t "~A"
-  (opera:usage
-   "candle"
-   (main-options)
-   "Interacts with candle server.  The available commands are:
-  project   List, show or add projects
-  job       List or show jobs
-  run       Local command.  Run candle in the current working directory")))
-
 (defgeneric execute-command (command args))
 
 (defmethod execute-command (command args)
  (format *error-output* "Unknown command '~(~A~)'.  See 'candle --help'.~%" command))
 
-(defun add-project (project-definition)
- (let
-  ((pos (position #\: project-definition)))
-  (cond
-   ((not pos) (format *error-output* "Project definition ~A is not valid.  See 'candle project --help'.~%" project-definition))
-   (t
-    (let*
-     ((name (subseq project-definition 0 pos))
-      (src (subseq project-definition (1+ pos))))
-     (communication:query `(candle:add-project ,name ,src))
-     (format t "Added project ~A at src definition ~A~%" name src))))))
-
-(defun delete-project (name)
- (communication:query `(candle:delete-project ,name))
- (format t "Removed project ~A~%" name))
-
 (defun job-info->line (job-info)
  (format nil "~A (~A) ~A"
   (subseq (first job-info) 0 8)
    (:no-candle-file "No candle file present")
    (:in-progress "In progress"))))
 
-(defun show-project (name)
- (let*
-  ((branch-infos (communication:query `(candle:project-branch-information ,name)))
-   (width (apply #'max (mapcar #'length (mapcar #'car branch-infos)))))
-  (mapcar
-   (lambda (branch-info)
-    (format t (format nil "~~~A@A: ~~A~~%" width)
-     (first branch-info)
-     (job-info->line (second branch-info))))
-   (sort branch-infos #'< :key (lambda (branch-info) (third (second branch-info)))))))
+;;; Section for ./candle
 
-(defun project-history (name)
- (format t "~{~A~%~}"
-  (mapcar
-   #'job-info->line
-   (sort (communication:query `(candle:project-job-information ,name)) #'< :key #'third))))
+(defun run ()
+ (multiple-value-bind (options remaining-args error) (opera:process-arguments (main-options) (cdr sb-ext:*posix-argv*))
+  (cond
+   ((opera:option-present :help options) (main-usage))
+   ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle --help'.~%" (car remaining-args)))
+   ((and (opera:option-present :port options) (not (parse-integer (opera:option-argument :port options) :junk-allowed t)))
+    (format *error-output* "--port requires a number.  See 'candle-server -h'~%"))
+   ((not remaining-args) (format *error-output* "Command required.  See 'candle --help'.~%"))
+   (t
+    (let
+     ((communication:*query-port*
+       (or
+        (and
+         (opera:option-present :port options)
+         (parse-integer (opera:option-argument :port options) :junk-allowed t))
+        25004)))
+     (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args)))))))
 
-(defun job-log (project-name sha)
- (format t "~A~%" (communication:query `(candle:get-job-log ,project-name ,sha))))
+(defun main-options ()
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+   (:name :port :short "p" :long "port" :takes-argument t :variable-name "PORT"
+    :description "Port on which to listen for commands.  Defaults to 25004")
+   (:positional "<command>" :required t :description "Command for candle, see below")))
 
-(defun refresh-project (name)
- (communication:query `(candle:refresh-project ,name))
- (format t "Refreshed project ~A~%" name))
+(defun main-usage ()
+ (format t "~A"
+  (opera:usage
+   "candle"
+   (main-options)
+   "Interacts with candle server.  The available commands are:
+  project   Interact with projects
+  job       Get information about jobs
+  run       Local command.  Run candle in the current working directory")))
+
+;;; Section for ./candle project
 
 (defmethod execute-command ((command (eql :project)) args)
  (multiple-value-bind (options remaining-args error) (opera:process-arguments (project-options) args)
   (cond
-   ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle project --help'.~%" (car remaining-args)))
-   ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle project --help'.~%" (car remaining-args)))
-   ((opera:option-present :help options) (format t "~A" (opera:usage "candle project" (project-options))))
-   ((opera:option-present :delete options) (delete-project (opera:option-argument :delete options)))
-   ((opera:option-present :show options) (show-project (opera:option-argument :show options)))
-   ((opera:option-present :refresh options) (refresh-project (opera:option-argument :refresh options)))
-   ((opera:option-present :add options) (add-project (opera:option-argument :add options))))))
+   ((eql error :unknown-option)
+    (format *error-output* "Unknown option: ~A.  See 'candle project --help'.~%" (car remaining-args)))
+   ((eql error :required-argument-missing)
+    (format *error-output* "Missing argument for ~A.  See 'candle project --help'.~%" (car remaining-args)))
+   ((opera:option-present :help options) (project-usage))
+   (t
+    (let
+     ((subcommand (intern (string-upcase (car remaining-args)) :keyword)))
+     (case subcommand
+      (:delete (delete-project (cdr remaining-args)))
+      (:add (add-project (cdr remaining-args)))
+      (:show (show-project (cdr remaining-args)))
+      (:refresh (refresh-project (cdr remaining-args)))
+      (t (project-usage))))))))
+
+(defun project-usage ()
+ (format t "~A"
+  (opera:usage
+   "candle project"
+   (project-options)
+   "Interacts with projects.  The available project subcommands are:
+  add       Add a project
+  delete    Delete a project
+  show      Show project branch information
+  refresh   Tell the candle server to refresh the project information")))
+
+(defun project-options ()
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+   (:positional "<subcommand>" :description "Project subcommand, see below.")))
+
+;   (:name :show :long "show" :takes-argument t :description
+;    "Show branch information for a project named by NAME."
+;    :variable-name "NAME")
+;   (:name :refresh :long "refresh" :takes-argument t :description
+;    "Refresh project named by NAME."
+;    :variable-name "NAME")
+;   (:name :delete :long "delete" :takes-argument t :description
+;    "Delete a project named by NAME."
+;    :variable-name "NAME")
+
+(defun add-project (args)
+ (let*
+  ((options
+   '((:name :help :short "h" :long "help" :description "Print this usage.")
+     (: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.")))
+    (usage (opera:usage "candle project add" options)))
+  (multiple-value-bind (options remaining-args error) (opera:process-arguments options args)
+   (cond
+    ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle project add --help'.~%" (car remaining-args)))
+    ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle project add --help'.~%" (car remaining-args)))
+    ((opera:option-present :help options) (format t "~A" usage))
+    ((not remaining-args) (format *error-output* "Required <name>:<src>.  See 'candle project add --help'.~%"))
+    (t
+     (let*
+      ((project-definition (car remaining-args))
+       (pos (position #\: project-definition)))
+      (cond
+       ((not pos) (format *error-output* "Project definition ~A is not valid.  See 'candle project --help'.~%" project-definition))
+       (t
+        (let*
+         ((name (subseq project-definition 0 pos))
+          (src (subseq project-definition (1+ pos))))
+         (communication:query `(candle:add-project ,name ,src))
+         (format t "Added project ~A at src definition ~A~%" name src))))))))))
+
+(defun delete-project (args)
+ (let*
+  ((options
+   '((:name :help :short "h" :long "help" :description "Print this usage.")
+     (:positional "<name>" :description "<name> is the name of the project to delete")))
+    (usage (opera:usage "candle project delete" options)))
+  (multiple-value-bind (options remaining-args error) (opera:process-arguments options args)
+   (cond
+    ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle project delete --help'.~%" (car remaining-args)))
+    ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle project delete --help'.~%" (car remaining-args)))
+    ((opera:option-present :help options) (format t "~A" usage))
+    ((not remaining-args) (format *error-output* "Required <name>.  See 'candle project delete --help'.~%"))
+    (t
+     (communication:query `(candle:delete-project ,(car remaining-args)))
+     (format t "Removed project ~A~%" (car remaining-args)))))))
+
+(defun show-project (args)
+ (let*
+  ((options
+   '((:name :help :short "h" :long "help" :description "Print this usage.")
+     (:positional "<name>" :description "<name> is the name of the project to show")))
+    (usage (opera:usage "candle project delete" options)))
+  (multiple-value-bind (options remaining-args error) (opera:process-arguments options args)
+   (cond
+    ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle project show --help'.~%" (car remaining-args)))
+    ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle project show --help'.~%" (car remaining-args)))
+    ((opera:option-present :help options) (format t "~A" usage))
+    ((not remaining-args) (format *error-output* "Required <name>.  See 'candle project show --help'.~%"))
+    (t
+     (let*
+      ((branch-infos (communication:query `(candle:project-branch-information ,(car remaining-args))))
+       (width (apply #'max (mapcar #'length (mapcar #'car branch-infos)))))
+      (mapcar
+       (lambda (branch-info)
+        (format t (format nil "~~~A@A: ~~A~~%" width)
+         (first branch-info)
+         (job-info->line (second branch-info))))
+       (sort branch-infos #'< :key (lambda (branch-info) (third (second branch-info)))))))))))
+
+(defun refresh-project (args)
+ (let*
+  ((options
+   '((:name :help :short "h" :long "help" :description "Print this usage.")
+     (:positional "<name>" :description "<name> is the name of the project to refresh")))
+    (usage (opera:usage "candle project refresh" options)))
+  (multiple-value-bind (options remaining-args error) (opera:process-arguments options args)
+   (cond
+    ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle project refresh --help'.~%" (car remaining-args)))
+    ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle project refresh --help'.~%" (car remaining-args)))
+    ((opera:option-present :help options) (format t "~A" usage))
+    ((not remaining-args) (format *error-output* "Required <name>.  See 'candle project refresh --help'.~%"))
+    (t
+     (communication:query `(candle:refresh-project ,(car remaining-args)))
+     (format t "Refreshed project ~A~%" (car remaining-args)))))))
+
+;;; Section for ./candle job
 
 (defmethod execute-command ((command (eql :job)) args)
  (multiple-value-bind (options remaining-args error) (opera:process-arguments (job-options) args)
    ((opera:option-present :log options) (job-log (opera:option-argument :project-name options) (opera:option-argument :log options)))
    (t (project-history (opera:option-argument :project-name options))))))
 
+(defun job-options ()
+ '((:name :help :short "h" :long "help" :description "Print this usage.")
+   (:name :project-name :long "project" :takes-argument t
+    :variable-name "PROJECT"
+    :description "The project name for the jobs under consideration.  Required argumnet.")
+   (:name :log :long "log" :takes-argument t
+    :variable-name "SHA"
+    :description "Show's the processing log for job at sha SHA.  SHA can be truncated.")))
+
+(defun project-history (name)
+ (format t "~{~A~%~}"
+  (mapcar
+   #'job-info->line
+   (sort (communication:query `(candle:project-job-information ,name)) #'< :key #'third))))
+
+(defun job-log (project-name sha)
+ (format t "~A~%" (communication:query `(candle:get-job-log ,project-name ,sha))))
+
+;;; Section for ./candle run
+
 (defmethod execute-command ((command (eql :run)) args)
  (multiple-value-bind (options remaining-args error) (opera:process-arguments (run-options) args)
   (cond
    ((opera:option-present :help options) (format t "~A" (opera:usage "candle run" (run-options))))
    ((not (candle:run)) (sb-ext:exit :code 1)))))
 
-(defun run ()
- (multiple-value-bind (options remaining-args error) (opera:process-arguments (main-options) (cdr sb-ext:*posix-argv*))
-  (cond
-   ((opera:option-present :help options) (main-usage))
-   ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle --help'.~%" (car remaining-args)))
-   ((and (opera:option-present :port options) (not (parse-integer (opera:option-argument :port options) :junk-allowed t)))
-    (format *error-output* "--port requires a number.  See 'candle-server -h'~%"))
-   ((not remaining-args) (format *error-output* "Command required.  See 'candle --help'.~%"))
-   (t
-    (let
-     ((communication:*query-port*
-       (or
-        (and
-         (opera:option-present :port options)
-         (parse-integer (opera:option-argument :port options) :junk-allowed t))
-        25004)))
-     (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args)))))))
+(defun run-options ()
+ '((:name :help :short "h" :long "help" :description "Print this usage.")))