moved most of build-app.lisp into src/app.lisp

3 files changed, 296 insertions, 279 deletions

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 <EXECUTION OPTION> <NAME or ID> [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 <http://www.gnu.org/licenses/>.
+
+(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 <EXECUTION OPTION> <NAME or ID> [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))))