Refactor job arguments to use subcommands

diff --git a/src/main/cli.lisp b/src/main/cli.lisp
index 9e071afc95433a017a031e454c94c1b639722cd7..4b56b16a8016cec79f3f8fe5e1dd5b085c970639 100644 (file)
--- a/src/main/cli.lisp
+++ b/src/main/cli.lisp
@@ -101,7 +101,7 @@
     ((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))
+     ((not pos) (format *error-output* "Project definition ~A is not valid.  See 'candle project add --help'.~%" project-definition))
      (t
       (let*
        ((name (subseq project-definition 0 pos))
@@ -159,32 +159,64 @@
 ;;; Section for ./candle job
 
 (defmethod execute-command ((command (eql :job)) args)
- (multiple-value-bind (options remaining-args error) (opera:process-arguments (job-options) args)
-  (cond
-   ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle job --help'.~%" (car remaining-args)))
-   ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle job --help'.~%" (car remaining-args)))
-   ((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")))
-   ((not (opera:option-present :project-name options)) (format *error-output* "Requires --project argument.  See 'candle job --help'.~%" ))
-   ((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))))))
+ (standard-cli "candle job" (job-options) args (job-usage) nil
+  (let
+   ((subcommand (intern (string-upcase (car remaining-args)) :keyword)))
+   (case subcommand
+    (:list (job-list (cdr remaining-args)))
+    (:log (job-log (cdr remaining-args)))
+    (t (format t "~A" (job-usage)))))))
+; (multiple-value-bind (options remaining-args error) (opera:process-arguments (job-options) args)
+;  (cond
+;   ((eql error :unknown-option) (format *error-output* "Unknown option: ~A.  See 'candle job --help'.~%" (car remaining-args)))
+;   ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A.  See 'candle job --help'.~%" (car remaining-args)))
+;   ((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")))
+;   ((not (opera:option-present :project-name options)) (format *error-output* "Requires --project argument.  See 'candle job --help'.~%" ))
+;   ((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))))
+   (:positional "<subcommand>" :description "Job subcommand, see below.")))
+
+(defun job-usage ()
+ (opera:usage
+  "candle job"
+  (project-options)
+  "Interacts with projects.  The available project subcommands are:
+ list                 List jobs
+ log <project>:<sha>  View the log for a job"))
+
+(defun job-list (args)
+ (let
+  ((options
+   '((:name :help :short "h" :long "help" :description "Print this usage.")
+     (:name :project :long "project" :variable-name "PROJECT" :takes-argument t :description "Restrict jobs to project named by PROJECT"))))
+  (standard-cli "candle job list" options args :default nil
+   (format t "~{~A~%~}"
+    (mapcar
+     #'job-info->line
+     (sort (communication:query `(candle:project-job-information ,(opera:option-argument :project parsed-options))) #'< :key #'third))))))
+
+(defun decompose-job-definition (job-definition)
+ (let
+  ((pos (position #\: job-definition)))
+  (when
+   pos
+   (values
+    (subseq job-definition 0 pos)
+    (subseq job-definition (1+ pos))))))
+
+(defun job-log (args)
+ (let
+  ((options
+   '((:name :help :short "h" :long "help" :description "Print this usage.")
+     (:positional "<project>:<sha>" :description "<project> is the name of the project, while <sha> is the sha of the job in question."))))
+  (standard-cli "candle job log" options args :default "<project>:<sha>"
+   (multiple-value-bind (project-name sha) (decompose-job-definition (car remaining-args))
+    (if project-name
+     (format t "~A" (communication:query `(candle:get-job-log ,project-name ,sha)))
+     (format *error-output* "Job definition ~A is not valid.  See 'candle job log --help'.~%" (car remaining-args)))))))
 
 ;;; Section for ./candle run
 

diff --git a/src/main/server.lisp b/src/main/server.lisp
index f95976e3b1a3a066b51381cdfdc7bc3ef5e214ff..11edcce5e284e5e58f66f6e1d447150912dcb952 100644 (file)
--- a/src/main/server.lisp
+++ b/src/main/server.lisp
@@ -86,9 +86,12 @@
 
 (defun project-job-information (name)
  (let
-  ((project (find name *all-project* :test #'string= :key #'project-name)))
-  (when (not project) (error "Project does not exist"))
-  (mapcar #'job->job-information (find-job-by-project project))))
+  ((project (when name (find name *all-project* :test #'string= :key #'project-name))))
+  (when (and name (not project)) (error "Project does not exist"))
+  (mapcar #'job->job-information
+   (if project
+    (find-job-by-project project)
+    *all-job*))))
 
 (defun get-job-log (project-name sha)
  (let*