[wip] working on clingon refactor

1 files changed, 27 insertions, 360 deletions

diff --git a/app/app.lisp b/app/app.lisp
index 784d887..a4ff596 100644
--- a/app/app.lisp
+++ b/app/app.lisp
@@ -19,366 +19,33 @@
 (in-package :oneliners.cli.app)
 
 ;;; VERSION
-(defparameter +ol-version+ "0.7.1")
-
-;;; HELP TEXTS
-(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 
-
-")
-
-(defparameter +icons-in-printout-docs+
-  "In the printout of oneliners, several unicode \"icons\" appear.
-Their meaning is as follows:
-
-- ⚠ : Indicates that the oneliner is flagged. 
-- 🔒 : Indicates that the oneliner is locked.
-- 📋 : Indicates that the oneliner will be copied to the clipboard.
-
-")
-
-
-;;; CLON SYNOPSIS DEFINITION 
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun group-by (n xs &optional default)
-    (loop for l on xs by (lambda (l) (nthcdr n l))
-          when (<= n (length l))
-            collect (subseq l 0 n)
-          else
-            collect (append l (loop repeat (- n (length l)) collect default))))
-  
-  (defun tabulate-strings (line-width columns strings)
-    (let ((row-format
-            (apply 'concatenate 'string
-                   "~" (prin1-to-string line-width) "<"
-                   (loop for i from 0 below columns
-                         collect "~a"
-                         when (< i (1- columns))
-                         collect "~;"
-                       else
-                         collect "~>"))))
-    (loop for group in (group-by columns strings " ")
-          collect (apply 'format nil row-format group)))))
-
-(defsynopsis (:postfix "COMMAND [ARGS...]")
-  (group (:header "SEARCHING FOR ONELINERS" :hidden t)
-         (text :contents "Usage: ol [OPTIONS] search [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:")
-         (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 TERMS, 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 TERMS.")
-         (flag :long-name "newest"
-               :description "Return newest oneliners that match. Without any TERMS, simply returns the newest oneliners."))
-  (group (:header "RUNNING ONELINERS" :hidden t)
-         (text :contents "Usage: ol [OPTIONS] run <IDENTIFIER> [ARGS...]")
-         (text :contents " ")
-         (text :contents "Run the oneliner identified by IDENTIFIER, if it exists, with any required ARGS.")
-         (text :contents "IDENTIFIER should either be the name or the unique numeric ID of a oneliner.")
-         (text :contents "E.g. `ol run demo foo bar` # run \"demo\" with args \"foo\" and \"bar\"")
-         (text :contents " ")
-         (text :contents "Options:")
-         (lispobj :long-name "timeout"
-                  :argument-type :optional
-                  :argument-name "SECONDS"
-                  :default-value 1
-                  :typespec 'integer 
-                  :description "How many seconds to wait for standard output before giving up.")
-         (flag :long-name "verbose"
-               :short-name "v"
-               :description "Prints a message indicating the oneliner text that is about to be run prior to execution.")
-         (flag :long-name "confirm"
-               :short-name "c"
-               :description "Prompts the user for confirmation before running. Implies --verbose.")
-         (flag :long-name "draft"
-               :description "Indicates that you wish to run a draft of a oneliner identified by IDENTIFIER."))
-  (group (:header "CLIPPING ONELINERS" :hidden t)
-         (text :contents "Usage: ol clip <IDENTIFIER> [ARGS...]")
-         (text :contents " ")
-         (text :contents "Instead of running a oneliner, copy it to your system's clipboard")
-         (text :contents "ol clip demo-1 foo extra=bar"))
-  (group (:header "SHOWING INFORMATION ABOUT ONELINERS" :hidden t)
-         (text :contents "Usage: ol show <IDENTIFIER>")
-         (text :contents " ")
-         (text :contents "Print information about a oneliner to the screen."))
-  (group (:header "NEW ONELINERS" :hidden t)
-         (text :contents "Usage: ol new")
-         (text :contents " ")
-         (text :contents "Interactively create a new oneliner and upload it to the server."))
-  (group (:header "EDITING ONELINERS" :hidden t)
-         (text :contents "Usage: ol edit <IDENTIFIER>")
-         (text :contents " ")
-         (text :contents "Interactively alter a oneliner and uplaod it to the server.")
-         (text :contents " ")
-         (text :contents "Options:")
-         (flag :long-name "redraft"
-               :description "Indicates that you wish to edit a draft instead of a published oneliner."))
-  (group (:header "PUBLISHING ONELINER DRAFTS" :hidden t)
-         (text :contents "Usage: ol publish <DRAFT>")
-         (text :contents " ")
-         (text :contents "Submits a draft oneliner to the wiki server, and, when successful, deletes the draft."))
-  (group (:header "DRAFTS LISTING" :hidden t)
-         (text :contents "Usage: ol drafts")
-         (text :contents " ")
-         (text :contents "Prints a listing of current drafts of oneliners yet to be published."))
-  (group (:header "TRASH DRAFT" :hidden t)
-         (text :contents "Usage: ol trash <DRAFT>")
-         (text :contents " ")
-         (text :contents "Trashes a draft."))
-  (group (:header "FLAGGING AND UNFLAGGING ONELINERS" :hidden t)
-         (text :contents "Usage: ol <flag | unflag> <IDENTIFIER>")
-         (text :contents " ")
-         (text :contents
-               "Flag or unflag a oneliner. A flagged oneliner is marked as potentially hazardous and will prompt users before exectuion.")
-         (text :contents
-               "Flagged oneliners may also be specifically factor into search using the --all-flagged or --not-flagged search options."))
-  (group (:header "LOCKING AND UNLOCKING ONELINERS" :hidden t)
-         (text :contents "Usage: ol <lock | unlock> <IDENTIFIER>")
-         (text :contents " ")
-         (text :contents "(ADMINS ONLY) Lock or unlock a oneliner. A locked oneliner may not be altered or edited."))
-  (group  (:header "REDEEMING INVITE TOKENS" :hidden t)
-          (text :contents "Usage: ol redeem <INVITE> <HANDLE> <PASSWORD>")
-          (text :contents " ")
-          (text :contents "Redeem an invite token, INVITE, and reate a new contributor account on the wiki server with user handle and password."))
-  (group (:header "INVITE TOKENS" :hidden t)
-         (text :contents "Usage: ol invite")
-         (text :contents " ")
-         (text :contents "Generate a new invite token if you are allowed to do so."))
-  (group (:header "LOGIN AND LOGOUT" :hidden t)
-         (text :contents "Usage: ol <login | logout> [HANDLE PASWORD]")
-         (text :contents " ")
-         (text :contents "Login or logout. If logging in, provide a handle and password.")
-         (text :contents "Once logged in to your configured server, an API access token will be written to your config file, allowing you to make contributions to the wiki."))
-  (group (:header "PASSWORD CHANGES" :hidden t)
-         (text :contents "Usage: ol password <OLD> <NEW> <REPEATED>")
-         (text :contents " ")
-         (text :contents "Change your password on the configured server."))
-  (group (:header "SIGNATURE CHANGES" :hidden t)
-         (text :contents "Usage: ol signature")
-         (text :contents " ")
-         (text :contents "Interactively update your contributor signature."))
-  (group (:header "WHOIS CONTRIBUTOR" :hidden t)
-         (text :contents "Usage: ol whois <HANDLE>")
-         (text :contents " ")
-         (text :contents "Print information about a contributor."))
-  (group (:header "EDITOR CONFIGURATION" :hidden t)
-         (text :contents +configure-your-edtior+))
-  (group (:header "VARIABLES IN ONELINERS" :hidden t)
-         (text :contents +oneliners-variables-help-text+))
-  (group (:header "ICONS IN PRINTOUT" :hidden t)
-         (text :contents +icons-in-printout-docs+))
-  (group (:header "VERSION" :hidden t)
-         (text :contents "Usage: ol version")
-         (text :contents " ")
-         (text :contents "Prints the version of this client."))
-  (group (:header "HELP MENU")
-         (text :contents "Usage: ol help [SECTION]")
-         (text :contents " ")
-         (text :contents "Print a help menu. With no arguments, prints this help.")
-         (text :contents " ")
-         (text :contents  "Command sections include:")
-         (text :contents
-               (str:join
-                #\newline
-                (tabulate-strings
-                 40 5
-                 '("search"  "run"  "clip"   "show"   "new"  "edit"
-                   "delete"  "drafts"  "trash"  "publish"  "flag"
-                   "lock"  "redeem" "invite" "login"  "whois"
-                   "password" "signature" "version"))))
-         (text :contents " ")
-         (text :contents "Additional topics include:")
-         (text :contents
-               (str:join
-                #\newline
-                (tabulate-strings
-                 40 5
-                 '("variables" "editor" "icons"))))))
-
-;;; 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)
-                                :end2 (length header)))
-          return item))
-
-;;; MAIN ENTRY POINT
+(defparameter +ol-version+ "0.8.0")
+
+(defun toplevel/options ()
+  "Returns a list of the top level command's options"
+  (list))
+
+(defun toplevel/subcommands ()
+  "Returns a list of the subcommands for the top level command"
+  (list
+   (search/command)))
+
+(defun toplevel/handler (cmd)
+  "Prints usage statement and then exits"
+  (cli:print-usage-and-exit cmd *standard-output*))
+
+(defun toplevel/command ()
+  "Returns the toplevel command object."
+  (cli:make-command
+   :name "ol"
+   :version +ol-version+
+   :description "CLI client for oneliners wiki service."
+   :authors '("Colin Okay <colin@cicadas.surf>")
+   :license "AGPL-3.0-only"
+   :handler #'toplevel/handler
+   :options (toplevel/options)
+   :sub-commands (toplevel/subcommands)))
 
 (defun main ()
-  (macrolet ((help-and-quit-unless (topic check)
-               `(unless ,check
-                  (help-topic ,topic)
-                  (uiop:quit)))) 
-    (make-context)
-    (handler-case 
-        (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 
-                (handler-case 
-                    (ecase (a:make-keyword (string-upcase command))
-                      (:help
-                       (princ #\newline)
-                       (help-topic (or (first args) "help")))
-                      (:version
-                       (format t "ol v~a~%" +ol-version+ ))
-                      (:search
-                       (cond
-                         ;; if there are args, use them as search terms
-                         (args 
-                          (cli:search-for-oneliners
-                           args
-                           (getopt :long-name "limit")
-                           (getopt :long-name "not-flagged")
-                           (getopt :long-name "all-flagged")
-                           (getopt :long-name "newest")))
-                         ;; no args, but a --newest flag, just return newest
-                         ((getopt :long-name "newest")
-                          (cli::newest-oneliners (getopt :long-name "limit")))
-                         ;; no args, but a --all-falgged
-                         ((getopt :long-name "all-flagged")
-                          (cli::all-flagged-oneliners (getopt :long-name "limit")))
-                         ;; otherwise, print help for search
-                         (t
-                          (help-topic "search")
-                          (uiop:quit))))
-
-                      (:run
-                       (help-and-quit-unless "run" id-or-name)
-                       (cli:run-item id-or-name (rest args)
-                                     :verbose (getopt :long-name "verbose")
-                                     :confirm (getopt :long-name "confirm")
-                                     :timeout (getopt :long-name "timeout")
-                                     :draftp (getopt :long-name "draft")))
-                      (:clip
-                       (help-and-quit-unless "clip" id-or-name)
-                       (cli:run-item id-or-name (rest args)
-                                     :force-clip t
-                                     :draftp (getopt :long-name "draft")))
-                      (:show
-                       (help-and-quit-unless "show" id-or-name)
-                       (cli:print-item-explanation id-or-name))
-                      (:new
-                       (cli:add-new-oneliner))
-                      (:edit
-                       (help-and-quit-unless "edit" id-or-name)
-                       (cli:edit-item id-or-name (getopt :long-name "redraft")))
-                      (:delete
-                       (help-and-quit-unless "delete" id-or-name)
-                       (cli::delete-item id-or-name))
-                      (:publish
-                       (help-and-quit-unless "publish" id-or-name)
-                       (cli::publish-draft id-or-name))
-                      (:trash
-                       (help-and-quit-unless "trash" id-or-name)
-                       (cli::drop-draft id-or-name))
-                      (:drafts
-                       (cli::print-drafts))
-                      (:flag
-                       (help-and-quit-unless "flag" id-or-name)
-                       (cli:flag-item id-or-name))
-                      (:unflag
-                       (help-and-quit-unless "flag" id-or-name)
-                       (cli:unflag-item id-or-name))
-                      (:lock
-                       (help-and-quit-unless "lock" id-or-name)
-                       (cli:lock-item id-or-name))
-                      (:unlock
-                       (help-and-quit-unless "lock" id-or-name)
-                       (cli:unlock-item id-or-name))
-                      (:redeem
-                       (help-and-quit-unless "redeem" (= 3 (length args)))
-                       (apply 'cli:redeem-invite args))
-                      (:invite
-                       (cli:request-invite-code))
-                      (:login
-                       (help-and-quit-unless "login" (= 2 (length args)))
-                       (apply 'cli:login args))
-                      (:logout
-                       (cli:revoke-access))
-                      (:password
-                       (help-and-quit-unless "password" (= 3 (length args)))
-                       (apply 'cli:change-pw args))
-                      (:signature
-                       (cli:change-signature))
-                      (:whois
-                       (help-and-quit-unless "whois" args)
-                       (cli:show-contributor (first args))))
-                  (#+sbcl sb-kernel:case-failure ()
-                    (help-topic "help"))))))
-          (help-topic "help"))
-      (#+sbcl sb-sys:interactive-interrupt
-       #+ccl ccl:interrupt-signal-condition
-       ()
-        (format t "Aborted by User Interrupt.~%")
-        (uiop:quit))))
-  (uiop:quit))
-
-(defun help-topic (topic)
-  (a:if-let (group (find-group-with-header topic))
-    (help :item group)
-    (help)))
-
-
+  (cli:run (toplevel/command)))