From dd22216b2d84341c4aac2dec3692bf36d9655f5a Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Sun, 6 Mar 2022 11:08:31 -0600 Subject: moved most of build-app.lisp into src/app.lisp --- build-app.lisp | 279 +-------------------------------------------------- oneliners.cli.asd | 3 +- src/app.lisp | 293 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 296 insertions(+), 279 deletions(-) create mode 100644 src/app.lisp diff --git a/build-app.lisp b/build-app.lisp index c4fc351..2adc30f 100644 --- a/build-app.lisp +++ b/build-app.lisp @@ -18,284 +18,7 @@ (asdf:load-system "oneliners.cli") - -(defpackage #:oneliners.cli.app - (:use #:cl #:net.didierverna.clon) - (:local-nicknames (#:a #:alexandria) - (#:cli #:oneliners.cli))) - (in-package :oneliners.cli.app) - -;;; VERSION -(defparameter +ol-version+ "0.6.0") - -;;; HELP TEXTS -(defparameter +invite-help-text+ - " -New contributor accounts are added to the your oneliners server by -redeeming invite tokens. - -When the --redeem option is passed, the ARGS section is expected to be -three items long, and is interpreted as TOKEN USERNAME PASSWORD. E.g.: - - ol --redeem PHONEYTOKEN c00lhacker my1337pw - -Would attempt to make a new user named c00lhacker with password -my1337pw.") - -(defparameter +oneliners-variables-help-text+ -" -Oneliners may contain variables. There are positional variables and -named variables. - -POSITIONAL VARIABLES appear in the oneliner as a # followed by a -number, which must 1 or greater. For example: - - echo Hello #1, Happy #2 - -The #1 and #2 are a positional variables. You might call the above -like - - ol --run 8 Doofus Tuesday - -Assuming that the above oneliner has ID 8, then \"Hello Doofus, - Happy Tuesday\" would print to the console. - -NAMED VARIABLES are similar. They appear in the oneliner as # followed -by a letter in the Roman alphabet, followed by any sequence of Roman -letters, numbers, or the symbol _. For example: - - echo Hello #name you get a #thing - -The #name and #thing are named variables. You might call the above like so: - - ol --run 3 name=Goober thing='sock in the nose' - -Which should print \"Hello Goober you get a sock in the nose\". - -Finally, you can MIX POSITIONAL AND NAMED VARIABLES so long as, when -you run the oneliner, all positional variables appear first. -") - -(defparameter +configure-your-edtior+ - "Adding explainations for oneliners, either with --add or --edit, -will use a default system editor. If you do not like the default -editor you may configure it by the exporting the EDITOR environment -variable to whatever you prefer. - -E.g. in your .bashrc you might put - -export EDITOR=/usr/bin/zile - -") - - -;;; CLON SYNOPSIS DEFINITION - -(defsynopsis (:postfix "[ARGUMENTS ...]") - (group (:header "SEARCH OPTIONS") - (text :contents "By default, ARGUMENTS are interpeted as search terms for oneliners. For example:") - (text :contents "$ ol grep awk # search for oneliners involving both grep and awk") - (text :contents " ") - - (lispobj :long-name "limit" - :argument-type :optional - :argument-name "NUMBER" - :default-value 10 - :description "The maximum number of results to return." - :typespec 'integer) - (flag :long-name "all-flagged" - :description "Request that only flagged oneliners are returned. Without any ARGUMENTS, simply returns all flagged oneliners.") - (flag :long-name "not-flagged" - :description "Request that no flagged oneliners are returned with the search results. Does nothing without ARGUMENTS") - (flag :long-name "newest" - :description "Return newest oneliners that match. Without any ARGUMENTS, simply returns the newest oneliners.")) - (text :contents " ") - (group (:header "EXECUTION OPTIONS") - (text :contents "Several options override the default interpretation of ARGUMENTS.") - (text :contents "Execution options interpret the first argument as the identifier of a oneliner: ") - (text :contents "$ ol [MORE ARGUMENTS...]") - (text :contents " ") - (flag :long-name "run" - :description "Executes a oneliner by NAME or ID. See also help topic 'variables'.") - (flag :long-name "clip" - :description "Like --run, but puts the oneliner into the clipboard.")) - (text :contents " ") - (group (:header "OTHER OPTIONS") - (flag :long-name "show" - :description "View all information for the oneliner given by NAME or ID") - (lispobj :long-name "timeout" - :argument-type :optional - :argument-name "SECONDS" - :default-value 2 - :typespec 'integer - :description "How long to wait for standard output before giving up.")) - (text :contents " ") - (group (:header "HELP OPTIONS") - (flag :long-name "whois" - :description "View information about a contributor. The first argument is a contributor handle.") - (flag :long-name "help" - :description "Print help for a topic. Topics: wiki, account, invites, variables, editor") - (flag :long-name "version" - :description "Print the client's version")) - (group (:header "Advanced Options" :hidden t) - (flag :long-name "clear-cache" - :description "Clears all cached search results from your system.")) - (group (:header "Editor" :hidden t) - (text :contents +configure-your-edtior+)) - (group (:header "Variables" :hidden t) - (text :contents +oneliners-variables-help-text+)) - (group (:header "Wiki" :hidden t) - (text :contents "Options For Managing Oneliners") - (flag :long-name "add" - :description "Intaractively add a oneliner and update the wiki.") - (flag :long-name "edit" - :description "Interactively edit a oneliner and update the wiki.") - (flag :long-name "flag" - :description "Flag a oneliner for review.") - (flag :long-name "unflag" - :description "If you have admin priviliges, unflag a oneliner.") - (flag :long-name "lock" - :description "If you have admin priviliges, lock a oneliner from being edited.") - (flag :long-name "unlock" - :description "If you have admin priviliges, unlock a oneliner.")) - (group (:header "Account" :hidden t) - (text :contents "Options for Managing Your Contributor Account") - (flag :long-name "login" - :description "Attempt to login to your contributor account. ARGS are interpreted as USERNAME PASSWORD.") - (flag :long-name "logout" - :description "Revoke your own access token.") - (flag :long-name "change-password" - :description "Change your password. ARGS are interpreted as CURRENTPW NEWPW NEWPWAGAIN") - (flag :long-name "change-signature" - :description "Change your contributor signature. You will be prompted.")) - (group (:header "Invites" :hidden t) - (text :contents " ") - (text :contents "Options For Making Invites and Redeeming Tokens") - (flag :long-name "invite" - :description "Request an invite token to send to a friend.") - (flag :long-name "redeem" - :description "Redeem an invite token.") - (text :contents +invite-help-text+))) - -;;; HELPERS - -(defun find-group-with-header (header) - "This function should be built in. Is it? How to know? The -documentation is both extensive and trash. Any manual that expects -you to go to sleep with it at night is written for the author more -than the users." - (loop for item in (net.didierverna.clon::items *synopsis*) - when (and (typep item 'net.didierverna.clon::group) - (string-equal header (net.didierverna.clon::header item))) - return item)) - - -;;; MAIN ENTRY POINT - -(defun prepare-oneliner-arguments (arguments) - "Takes a list of arguments, as gathered by (REMAINDER), and returns - a list that looks like (ID-OR-NAME . ARGS) where ID-OR-NAME is - either an integer or a string." - (a:if-let (id (parse-integer (first arguments) :junk-allowed t)) - (cons id (rest arguments)) - arguments)) - -(defun main () - "Entry point for our standalone application." - (make-context) - (handler-case - (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)) - (uiop:quit)) - ((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 "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 - (cli::search-for-oneliners arguments - (getopt :long-name "limit") - (getopt :long-name "not-flagged") - (getopt :long-name "all-flagged") - (getopt :long-name "newest"))))) - (uiop:quit)) - (t - (help))) - (uiop:quit)) - (error (e) - (format *error-output* "~%ERROR: ~a~%" e) - (uiop:quit)) - (#+sbcl sb-sys:interactive-interrupt - #+ccl ccl:interrupt-signal-condition - #+ecl ext:interactive-interrupt - () - (format t "Aborted by User Interrupt.~%") - (uiop:quit)))) - ;;; DUMP EXECUTABLE +(dump "ol" main) ; from clon -(dump "ol" main) diff --git a/oneliners.cli.asd b/oneliners.cli.asd index fa3f9b8..86d69a9 100644 --- a/oneliners.cli.asd +++ b/oneliners.cli.asd @@ -13,7 +13,8 @@ "oneliners.api-client") :components ((:module "src" :components - ((:file "lib")))) + ((:file "lib") + (:file "app")))) :description "") diff --git a/src/app.lisp b/src/app.lisp new file mode 100644 index 0000000..812081f --- /dev/null +++ b/src/app.lisp @@ -0,0 +1,293 @@ +;;;; app.lisp -- definition of CLI options and entry point. + +;; Copyright (C) 2022 Colin Okay + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU Affero General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU Affero General Public License for more details. + +;; You should have received a copy of the GNU Affero General Public License +;; along with this program. If not, see . + +(defpackage #:oneliners.cli.app + (:use #:cl #:net.didierverna.clon) + (:local-nicknames (#:a #:alexandria) + (#:cli #:oneliners.cli))) + +(in-package :oneliners.cli.app) + +;;; VERSION +(defparameter +ol-version+ "0.6.0") + +;;; HELP TEXTS +(defparameter +invite-help-text+ + " +New contributor accounts are added to the your oneliners server by +redeeming invite tokens. + +When the --redeem option is passed, the ARGS section is expected to be +three items long, and is interpreted as TOKEN USERNAME PASSWORD. E.g.: + + ol --redeem PHONEYTOKEN c00lhacker my1337pw + +Would attempt to make a new user named c00lhacker with password +my1337pw.") + +(defparameter +oneliners-variables-help-text+ +" +Oneliners may contain variables. There are positional variables and +named variables. + +POSITIONAL VARIABLES appear in the oneliner as a # followed by a +number, which must 1 or greater. For example: + + echo Hello #1, Happy #2 + +The #1 and #2 are a positional variables. You might call the above +like + + ol --run 8 Doofus Tuesday + +Assuming that the above oneliner has ID 8, then \"Hello Doofus, + Happy Tuesday\" would print to the console. + +NAMED VARIABLES are similar. They appear in the oneliner as # followed +by a letter in the Roman alphabet, followed by any sequence of Roman +letters, numbers, or the symbol _. For example: + + echo Hello #name you get a #thing + +The #name and #thing are named variables. You might call the above like so: + + ol --run 3 name=Goober thing='sock in the nose' + +Which should print \"Hello Goober you get a sock in the nose\". + +Finally, you can MIX POSITIONAL AND NAMED VARIABLES so long as, when +you run the oneliner, all positional variables appear first. +") + +(defparameter +configure-your-edtior+ + "Adding explainations for oneliners, either with --add or --edit, +will use a default system editor. If you do not like the default +editor you may configure it by the exporting the EDITOR environment +variable to whatever you prefer. + +E.g. in your .bashrc you might put + +export EDITOR=/usr/bin/zile + +") + + +;;; CLON SYNOPSIS DEFINITION + +(defsynopsis (:postfix "[ARGUMENTS ...]") + (group (:header "SEARCH OPTIONS") + (text :contents "By default, ARGUMENTS are interpeted as search terms for oneliners. For example:") + (text :contents "$ ol grep awk # search for oneliners involving both grep and awk") + (text :contents " ") + + (lispobj :long-name "limit" + :argument-type :optional + :argument-name "NUMBER" + :default-value 10 + :description "The maximum number of results to return." + :typespec 'integer) + (flag :long-name "all-flagged" + :description "Request that only flagged oneliners are returned. Without any ARGUMENTS, simply returns all flagged oneliners.") + (flag :long-name "not-flagged" + :description "Request that no flagged oneliners are returned with the search results. Does nothing without ARGUMENTS") + (flag :long-name "newest" + :description "Return newest oneliners that match. Without any ARGUMENTS, simply returns the newest oneliners.")) + (text :contents " ") + (group (:header "EXECUTION OPTIONS") + (text :contents "Several options override the default interpretation of ARGUMENTS.") + (text :contents "Execution options interpret the first argument as the identifier of a oneliner: ") + (text :contents "$ ol [MORE ARGUMENTS...]") + (text :contents " ") + (flag :long-name "run" + :description "Executes a oneliner by NAME or ID. See also help topic 'variables'.") + (flag :long-name "clip" + :description "Like --run, but puts the oneliner into the clipboard.")) + (text :contents " ") + (group (:header "OTHER OPTIONS") + (flag :long-name "show" + :description "View all information for the oneliner given by NAME or ID") + (lispobj :long-name "timeout" + :argument-type :optional + :argument-name "SECONDS" + :default-value 2 + :typespec 'integer + :description "How long to wait for standard output before giving up.")) + (text :contents " ") + (group (:header "HELP OPTIONS") + (flag :long-name "whois" + :description "View information about a contributor. The first argument is a contributor handle.") + (flag :long-name "help" + :description "Print help for a topic. Topics: wiki, account, invites, variables, editor") + (flag :long-name "version" + :description "Print the client's version")) + (group (:header "Advanced Options" :hidden t) + (flag :long-name "clear-cache" + :description "Clears all cached search results from your system.")) + (group (:header "Editor" :hidden t) + (text :contents +configure-your-edtior+)) + (group (:header "Variables" :hidden t) + (text :contents +oneliners-variables-help-text+)) + (group (:header "Wiki" :hidden t) + (text :contents "Options For Managing Oneliners") + (flag :long-name "add" + :description "Intaractively add a oneliner and update the wiki.") + (flag :long-name "edit" + :description "Interactively edit a oneliner and update the wiki.") + (flag :long-name "flag" + :description "Flag a oneliner for review.") + (flag :long-name "unflag" + :description "If you have admin priviliges, unflag a oneliner.") + (flag :long-name "lock" + :description "If you have admin priviliges, lock a oneliner from being edited.") + (flag :long-name "unlock" + :description "If you have admin priviliges, unlock a oneliner.")) + (group (:header "Account" :hidden t) + (text :contents "Options for Managing Your Contributor Account") + (flag :long-name "login" + :description "Attempt to login to your contributor account. ARGS are interpreted as USERNAME PASSWORD.") + (flag :long-name "logout" + :description "Revoke your own access token.") + (flag :long-name "change-password" + :description "Change your password. ARGS are interpreted as CURRENTPW NEWPW NEWPWAGAIN") + (flag :long-name "change-signature" + :description "Change your contributor signature. You will be prompted.")) + (group (:header "Invites" :hidden t) + (text :contents " ") + (text :contents "Options For Making Invites and Redeeming Tokens") + (flag :long-name "invite" + :description "Request an invite token to send to a friend.") + (flag :long-name "redeem" + :description "Redeem an invite token.") + (text :contents +invite-help-text+))) + +;;; HELPERS + +(defun find-group-with-header (header) + "This function should be built in. Is it? How to know? The +documentation is both extensive and trash. Any manual that expects +you to go to sleep with it at night is written for the author more +than the users." + (loop for item in (net.didierverna.clon::items *synopsis*) + when (and (typep item 'net.didierverna.clon::group) + (string-equal header (net.didierverna.clon::header item))) + return item)) + + +;;; MAIN ENTRY POINT + +(defun prepare-oneliner-arguments (arguments) + "Takes a list of arguments, as gathered by (REMAINDER), and returns + a list that looks like (ID-OR-NAME . ARGS) where ID-OR-NAME is + either an integer or a string." + (a:if-let (id (parse-integer (first arguments) :junk-allowed t)) + (cons id (rest arguments)) + arguments)) + +(defun main () + "Entry point for our standalone application." + (make-context) + (handler-case + (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)) + (uiop:quit)) + ((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 "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 + (cli::search-for-oneliners arguments + (getopt :long-name "limit") + (getopt :long-name "not-flagged") + (getopt :long-name "all-flagged") + (getopt :long-name "newest"))))) + (uiop:quit)) + (t + (help))) + (uiop:quit)) + (error (e) + (format *error-output* "~%ERROR: ~a~%" e) + (uiop:quit)) + (#+sbcl sb-sys:interactive-interrupt + #+ccl ccl:interrupt-signal-condition + #+ecl ext:interactive-interrupt + () + (format t "Aborted by User Interrupt.~%") + (uiop:quit)))) -- cgit v1.2.3