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 --- src/app.lisp | 293 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 293 insertions(+) create mode 100644 src/app.lisp (limited to 'src') 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