From 82a0911f93760a0059addc056340733f8797ae91 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Sun, 13 Mar 2022 10:46:41 -0500 Subject: new main in app.lisp; exports to oneliners.cli package --- app/app.lisp | 238 +++++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 156 insertions(+), 82 deletions(-) (limited to 'app') 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)) -- cgit v1.2.3