new main in app.lisp; exports to oneliners.cli package

1 files changed, 156 insertions, 82 deletions

diff --git a/app/app.lisp b/app/app.lisp
index 0e8b103..3cfb5cf 100644
--- a/app/app.lisp
+++ b/app/app.lisp
@@ -86,9 +86,9 @@ export EDITOR=/usr/bin/zile
 
 (defsynopsis (:postfix "COMMAND [ARGS...]")
   (group (:header "SEARCHING FOR ONELINERS" :hidden t)
-         (text :contents " ")
          (text :contents "Usage: ol [OPTIONS] search [TERMS...]")
-         (text :contents "Search for oneliners that have been tagged with all of TERMS")
+         (text :contents " ")
+         (text :contents "Search for oneliners that have been tagged with all of TERMS.")
          (text :contents "E.g. `ol search grep awk`")
          (text :contents " ")
          (text :contents "Options include:")
@@ -201,86 +201,160 @@ than the users."
 ;;; MAIN ENTRY POINT
 
 (defun main ()
-  "Entry point for our standalone application."
   (make-context)
-  (cli:with-local-state 
-    (let ((arguments (remainder)))
-      (cond
-        ((getopt :long-name "version")
-         (format t "Oneliner CLI Version: ~a~%" +ol-version+))
-        ((getopt :long-name "help")
-         (if (and arguments (find-group-with-header (first arguments)))
-             (help :item (find-group-with-header (first arguments)))
-             (help)))
-        ((getopt :long-name "whois")
-         (assert (first arguments) () "--whois requires an argument, a user handle.")
-         (cli::show-contributor (first arguments)))
+  (a:if-let (arguments (remainder))
+    (destructuring-bind (command . args) arguments
+      (let ((id-or-name
+              (when  args
+                (or (parse-integer (first args) :junk-allowed t)
+                    (first args))))) 
+        (cli:with-local-state 
+          (ecase (a:make-keyword (string-upcase command))
+            (:help
+             (princ #\newline)
+             (help-topic (first args)))
+            (:search
+             (cli:search-for-oneliners
+              args
+              (getopt :long-name "limit")
+              (getopt :long-name "not-flagged")
+              (getopt :long-name "all-flagged")
+              (getopt :long-name "newest")))
+            (:run
+             (cli:run-item id-or-name (rest args)
+                           :timeout (getopt :long-name "timeout")))
+            (:clip
+             (cli:run-item id-or-name (rest args)
+                           :force-clip t))
+            (:show
+             (cli:print-item-explanation id-or-name))
+            (:new
+             (cli:add-new-oneliner))
+            (:edit
+             (cli:edit-item id-or-name))
+            (:flag
+             (cli:flag-item id-or-name))
+            (:unflag
+             (cli:unflag-item id-or-name))
+            (:lock
+             (cli:lock-item id-or-name))
+            (:unlock
+             (cli:unlock-item id-or-name))
+            (:redeem
+             (unless (= 3 (length args))
+               (help-topic "redeem")
+               (uiop:quit))
+             (apply 'cli:redeem-invite args))
+            (:invite
+             (cli:request-invite-code))
+            (:login
+             (unless (= 3 (length args))
+               (help-topic "login")
+               (uiop:quit))
+             (apply 'cli:login args))
+            (:logout
+             (cli:revoke-access))
+            (:password
+             (unless (= 3 (length args))
+               (help-topic "password")
+               (uiop:quit))
+             (apply 'cli:change-pw args))
+            (:signature
+             (cli:change-signature))
+            (:whois
+             (unless args
+               (help-topic "whois")
+               (uiop:quit))
+             (cli:show-contributor (first args)))))))
+    (help))
+  (uiop:quit))
+
+(defun help-topic (topic)
+  (a:if-let (group (find-group-with-header topic))
+    (help :item group)
+    (help)))
+
+;; (defun main ()
+;;   "Entry point for our standalone application."
+;;   (make-context)
+;;   (cli:with-local-state 
+;;     (let ((arguments (remainder)))
+;;       (cond
+;;         ((getopt :long-name "version")
+;;          (format t "Oneliner CLI Version: ~a~%" +ol-version+))
+;;         ((getopt :long-name "help")
+;;          (if (and arguments (find-group-with-header (first arguments)))
+;;              (help :item (find-group-with-header (first arguments)))
+;;              (help)))
+;;         ((getopt :long-name "whois")
+;;          (assert (first arguments) () "--whois requires an argument, a user handle.")
+;;          (cli::show-contributor (first arguments)))
         
-        ((getopt :long-name "redeem")
-         (assert (= 3 (length arguments)) () "--redeem requires exatly three arguments.")
-         (destructuring-bind (token name pass) arguments
-           (cli::redeem-invite token name pass)))
-
-        ((getopt :long-name "login")
-         (assert (= 2 (length arguments)) () "--login requires exactly two arguments.")
-         (destructuring-bind (user pass) arguments
-           (cli::login user pass)))
-
-        ((getopt :long-name "change-password")
-         (assert (= 3 (length arguments)) () "--change-password requires exactly three arguments." )
-         (destructuring-bind (current new repeated) arguments
-           (cli::change-pw current new repeated)))
+;;         ((getopt :long-name "redeem")
+;;          (assert (= 3 (length arguments)) () "--redeem requires exatly three arguments.")
+;;          (destructuring-bind (token name pass) arguments
+;;            (cli::redeem-invite token name pass)))
+
+;;         ((getopt :long-name "login")
+;;          (assert (= 2 (length arguments)) () "--login requires exactly two arguments.")
+;;          (destructuring-bind (user pass) arguments
+;;            (cli::login user pass)))
+
+;;         ((getopt :long-name "change-password")
+;;          (assert (= 3 (length arguments)) () "--change-password requires exactly three arguments." )
+;;          (destructuring-bind (current new repeated) arguments
+;;            (cli::change-pw current new repeated)))
         
-        ((getopt :long-name "change-signature")
-         (cli::change-signature))
-
-        ((getopt :long-name "invite")
-         (cli::request-invite-code))
-
-        ((getopt :long-name "logout")
-         (cli::revoke-access))
-
-        ((getopt :long-name "add")
-         (cli::add-new-oneliner))
-
-        ((and (null arguments) (getopt :long-name "all-flagged"))
-         (cli::all-flagged-oneliners (getopt :long-name "limit")))
-
-        ((and (null arguments) (getopt :long-name "newest"))
-         (cli::newest-oneliners (getopt :long-name "limit")))
-
-        ((getopt :long-name "clear-cache")
-         (cli::wipe-cache))
-
-        (arguments
-         (destructuring-bind (id-or-name . args) (prepare-oneliner-arguments arguments) 
-           (cond
-             ((getopt :long-name "flag")
-              (cli::flag-item id-or-name ))
-             ((getopt :long-name "unflag")
-              (cli::unflag-item id-or-name))
-             ((getopt :long-name "lock")
-              (cli::lock-item id-or-name ))
-             ((getopt :long-name "unlock")
-              (cli::unlock-item id-or-name ))
-             ((getopt :long-name "edit")
-              (cli::edit-item id-or-name ))
-             ((getopt :long-name "show")
-              (cli::print-item-explanation id-or-name))
-             ((getopt :long-name "clip")
-              (cli::run-item id-or-name args
-                             :force-clip t
-                             :timeout (getopt :long-name "timeout")))
-             ((getopt :long-name "run")
-              (cli::run-item id-or-name args
-                             :timeout (getopt :long-name "timeout")))
-
-             (t                       ; arguments but no overriding flags, search wiki
-              (cli::search-for-oneliners arguments
-                                         (getopt :long-name "limit")
-                                         (getopt :long-name "not-flagged")
-                                         (getopt :long-name "all-flagged")
-                                         (getopt :long-name "newest"))))))
-        (t                            ; no arguments and no options, print help
-         (help)))))
-  (uiop:quit))
+;;         ((getopt :long-name "change-signature")
+;;          (cli::change-signature))
+
+;;         ((getopt :long-name "invite")
+;;          (cli::request-invite-code))
+
+;;         ((getopt :long-name "logout")
+;;          (cli::revoke-access))
+
+;;         ((getopt :long-name "add")
+;;          (cli::add-new-oneliner))
+
+;;         ((and (null arguments) (getopt :long-name "all-flagged"))
+;;          (cli::all-flagged-oneliners (getopt :long-name "limit")))
+
+;;         ((and (null arguments) (getopt :long-name "newest"))
+;;          (cli::newest-oneliners (getopt :long-name "limit")))
+
+;;         ((getopt :long-name "clear-cache")
+;;          (cli::wipe-cache))
+
+;;         (arguments
+;;          (destructuring-bind (id-or-name . args) (prepare-oneliner-arguments arguments) 
+;;            (cond
+;;              ((getopt :long-name "flag")
+;;               (cli::flag-item id-or-name ))
+;;              ((getopt :long-name "unflag")
+;;               (cli::unflag-item id-or-name))
+;;              ((getopt :long-name "lock")
+;;               (cli::lock-item id-or-name ))
+;;              ((getopt :long-name "unlock")
+;;               (cli::unlock-item id-or-name ))
+;;              ((getopt :long-name "edit")
+;;               (cli::edit-item id-or-name ))
+;;              ((getopt :long-name "show")
+;;               (cli::print-item-explanation id-or-name))
+;;              ((getopt :long-name "clip")
+;;               (cli::run-item id-or-name args
+;;                              :force-clip t
+;;                              :timeout (getopt :long-name "timeout")))
+;;              ((getopt :long-name "run")
+;;               (cli::run-item id-or-name args
+;;                              :timeout (getopt :long-name "timeout")))
+
+;;              (t                       ; arguments but no overriding flags, search wiki
+;;               (cli::search-for-oneliners arguments
+;;                                          (getopt :long-name "limit")
+;;                                          (getopt :long-name "not-flagged")
+;;                                          (getopt :long-name "all-flagged")
+;;                                          (getopt :long-name "newest"))))))
+;;         (t                            ; no arguments and no options, print help
+;;          (help)))))
+;;   (uiop:quit))