aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--CONTRIBUTING.org1
-rw-r--r--app/app.lisp447
-rw-r--r--lib/client.lisp255
-rw-r--r--lib/oneliner.lisp15
-rw-r--r--lib/package.lisp17
-rw-r--r--lib/state.lisp90
6 files changed, 541 insertions, 284 deletions
diff --git a/CONTRIBUTING.org b/CONTRIBUTING.org
index dbbe82e..669424c 100644
--- a/CONTRIBUTING.org
+++ b/CONTRIBUTING.org
@@ -29,4 +29,3 @@ To bring something up with the developers, send an email to
To keep up with developments and discuss this tool, join the mailing
list by visiting https://lists.sr.ht/~cbeo/oneliners.wiki and hitting
"subscribe".
-
diff --git a/app/app.lisp b/app/app.lisp
index 32f3ad2..c9372c8 100644
--- a/app/app.lisp
+++ b/app/app.lisp
@@ -19,22 +19,9 @@
(in-package :oneliners.cli.app)
;;; VERSION
-(defparameter +ol-version+ "0.6.0")
+(defparameter +ol-version+ "0.7.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
@@ -48,7 +35,7 @@ number, which must 1 or greater. For example:
The #1 and #2 are a positional variables. You might call the above
like
- ol --run 8 Doofus Tuesday
+ ol run 8 Doofus Tuesday
Assuming that the above oneliner has ID 8, then \"Hello Doofus,
Happy Tuesday\" would print to the console.
@@ -61,7 +48,7 @@ letters, numbers, or the symbol _. For example:
The #name and #thing are named variables. You might call the above like so:
- ol --run 3 name=Goober thing='sock in the nose'
+ ol run 3 name=Goober thing='sock in the nose'
Which should print \"Hello Goober you get a sock in the nose\".
@@ -81,94 +68,180 @@ 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
-(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")
+(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 " ")
-
- (lispobj :long-name "limit"
+ (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 ARGUMENTS, simply returns all flagged oneliners.")
+ :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 ARGUMENTS")
+ :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 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...]")
+ :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 " ")
- (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")
+ (text :contents "Options:")
(lispobj :long-name "timeout"
:argument-type :optional
:argument-name "SECONDS"
- :default-value 2
+ :default-value 1
: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)
+ :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" :hidden t)
+ (group (:header "VARIABLES IN ONELINERS")
(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)
+ (group (:header "ICONS IN PRINTOUT")
+ (text :contents +icons-in-printout-docs+))
+ (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 "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+)))
+ (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"))))
+ (text :contents " ")
+ (text :contents "Additional topics include:")
+(text :contents
+ (str:join
+ #\newline
+ (tabulate-strings
+ 40 5
+ '("variables" "editor" "icons"))))))
;;; HELPERS
@@ -179,100 +252,124 @@ 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)))
+ (string-equal header (net.didierverna.clon::header item)
+ :end2 (length header)))
return item))
-(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))
-
;;; 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)))
-
- ((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)))))
+ (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
+ (ecase (a:make-keyword (string-upcase command))
+ (:help
+ (princ #\newline)
+ (help-topic (or (first args) "help")))
+ (: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" (= 3 (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)))))))
+ (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)))
+
+
+
diff --git a/lib/client.lisp b/lib/client.lisp
index fe29932..61c3130 100644
--- a/lib/client.lisp
+++ b/lib/client.lisp
@@ -16,12 +16,16 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :oneliners.cli)
-;; NOTE WHILE HACKING. Each of the functions below that make HTTP
-;; requests is meant to be called within the body of a
-;; WITH-LOCAL-STATE form. If you are hacking in the REPL, make sure
-;; to wrap function calls appropriately.
+;;;; >>>>>NOTE WHILE HACKING<<<<<.
+;;;; ----------------------------------------------------------------
+;;;; Each of the functions below that make HTTP requests are meant to
+;;;; be called within the body of a WITH-LOCAL-STATE form. If you are
+;;;; hacking in the REPL, make sure to wrap function calls
+;;;; appropriately.
+;;;; ----------------------------------------------------------------
-;;; GETTING ONELINERS & Displaying oneliners
+
+;;; GETTING ONELINERS & DISPLAYING ONELINERS
(defun search-for-oneliners (terms limit &optional not-flagged-p all-flagged-p newestp)
(assert (loop for term in terms never (find #\, term)) () "Search terms may not contain commas.")
@@ -45,12 +49,18 @@ not in the local cache, try to fetch from configured server."
(defmacro when-oneliner ((var name-or-id) &body body)
"Finds the oneliner with name-or-id and binds it to var before
running the body. If such a oneliner can be found."
- (assert (symbolp var))
(let ((nvar (gensym)))
`(let ((,nvar ,name-or-id))
(a:when-let (,var (the-oneliner ,nvar))
,@body))))
+(defmacro when-draft ((var name) &body body)
+ "Like when-oneliner but restricts itself to local drafts."
+ (let ((nvar (gensym)))
+ `(let ((,nvar ,name))
+ (a:when-let (,var (fetch-draft ,nvar))
+ ,@body))))
+
(defun newest-oneliners (&optional limit)
(let ((response
(if limit
@@ -72,52 +82,62 @@ running the body. If such a oneliner can be found."
(princ #\newline)
(princ (oneliner-explanation ol)))))
+(defun print-drafts ()
+ (when *drafts*
+ (format t (concatenate 'string "~%~" (prin1-to-string *term-width*) "< ~;DRAFTS~; ~>~%"))
+ (dolist (draft *drafts*)
+ (print-oneliner-result-for-user (cdr draft)))))
+
;;; RUNNING ONELINERS
(defvar *ol-output-timeout* 1)
-(defun run-item (ident args &key force-clip (timeout nil timeout-p))
- (when-oneliner (ol ident)
- (let ((*ol-output-timeout* (if timeout-p timeout *ol-output-timeout*)))
- (bind-vars-and-run-oneliner ol args force-clip))))
+(defun run-item (ident args &key force-clip (timeout nil timeout-p) draftp verbose confirm)
+ "Runs a oneliner identified by IDENT (if available) with arguments ARGS."
+ (let ((ol (if draftp (fetch-draft ident) (the-oneliner ident))))
+ (when ol
+ (let ((*ol-output-timeout* (if timeout-p timeout *ol-output-timeout*)))
+ (bind-vars-and-run-oneliner ol args force-clip verbose confirm)))))
-(defun bind-vars-and-run-oneliner (ol args &optional force-clip)
+(defun bind-vars-and-run-oneliner (ol args &optional force-clip verbose confirm)
(let* ((oneliner (oneliner-oneliner ol))
(runstyle (oneliner-runstyle ol))
(pos-args (get-positional-arguments ol))
(named-args (get-named-arguments ol)))
+
+ (loop for param in pos-args
+ for arg in args
+ do (setf oneliner (str:replace-all param arg oneliner)))
+ ;; substitute named args
+
+ (setf args
+ (mapcar (lambda (s) (str:split "=" s))
+ (nthcdr (length pos-args) args)))
+ (loop for var in named-args
+ for bound = (assoc (subseq var 1) args :test #'equal)
+ when bound
+ do (setf oneliner
+ (str:replace-all var (second bound) oneliner)))
+
(when (or (not (oneliner-isflagged ol))
(y-or-n-p "This oneliner is flagged. Are you sure you want to run it?"))
+ (when (or verbose confirm)
+ (format t "Attempting to run:~%")
+ (princ oneliner)
+ (princ #\newline))
;; substitute positional args
- (loop for param in pos-args
- for arg in args
- do (setf oneliner (str:replace-all param arg oneliner)))
- ;; substitute named args
- (setf args
- (mapcar (lambda (s) (str:split "=" s))
- (nthcdr (length pos-args) args)))
- (loop for var in named-args
- for bound = (assoc (subseq var 1) args :test #'equal)
- when bound
- do (setf oneliner
- (str:replace-all var (second bound) oneliner)))
-
- (handle-run-oneliner oneliner (or force-clip (equalp runstyle "manual"))))))
+ (when (or (not confirm)
+ (y-or-n-p "Proceed?"))
+ (handle-run-oneliner oneliner (or force-clip (equalp runstyle "manual")))))))
(defun handle-run-oneliner (ol &optional clip)
(if clip
(progn (trivial-clipboard:text ol)
(format t "Copied oneliner to clipboard~%"))
- (progn
- (format t "Attempting to run:~%")
- (princ ol)
- (princ #\newline)
- (princ #\newline)
- (run-with-shell ol :shell-name (or (shell) "bash") :await-output-p *ol-output-timeout*))))
+ (run-with-shell ol :shell-name (or (shell) "bash") :await-output-p *ol-output-timeout*)))
;;; ADDING ONELINERS
-
(defun add-new-oneliner ()
(api-token) ;; fails with error if not set.
;; read each field required to make a onelienr in from a prompt.
@@ -131,8 +151,18 @@ running the body. If such a oneliner can be found."
(prompt "Name (leave blank for none): "
:expect 'valid-oneliner-name-p
:retry-text "Must begin with a letter contain only letters, numbers, - and _.")))
+
+ (draft-name
+ (unless (y-or-n-p "Upload immediately instead of keeping a draft?")
+ (if (plusp (length name))
+ name
+ (prompt "No name was provided, name this draft: "
+ :expect 'valid-oneliner-name-p
+ :retry-text "Must begin with a letter contain only letters, numbers, - and _."))))
+
(init-tags
(parse-oneliner-tags oneliner-string))
+
(brief
(prompt "Brief Description: "
:expect 'valid-brief-description-p
@@ -153,25 +183,34 @@ running the body. If such a oneliner can be found."
(when (y-or-n-p "Provide an explanation?")
(string-from-editor
(format nil "~a~%~%" oneliner-string)))))
- (api:request-with
- (:body (jonathan:to-json
- (list :oneliner oneliner-string
- :name (if (plusp (length name)) name :null)
- :tags tags
- :brief brief
- :explanation explanation
- :runstyle runstyle))
- :content-type "application/json")
- (api:post--oneliner :token (api-token)) ;TODO: update api to return the instance created.
- (format t "Added~%"))))
+ (let ((local
+ (make-oneliner
+ :oneliner oneliner-string
+ :name name
+ :tags tags
+ :brief brief
+ :explanation explanation
+ :runstyle runstyle)))
+ (if draft-name
+ ;; if this is a draft, save it to disk.
+ (progn
+ (put-draft draft-name local)
+ (format t "Saved draft ~a~%Do `ol --draft run ~a` to test~%"
+ draft-name
+ draft-name))
+ ;; otherwise, format the oneliner as json and make a request
+ ;; to create a new oneliner in the wiki
+ (api:request-with
+ (:body (oneliner-to-json-body local)
+ :content-type "application/json")
+ (api:post--oneliner :token (api-token)) ;TODO: update api to return the instance created.
+ (format t "Added Oneliner~%"))))))
;;; EDITING ONELINERS
-(defun edit-item (ident)
+(defun edit-item (ident &optional draftp)
(api-token) ;; fails with error if not set.
- (when-oneliner (ol ident)
- ;; Like adding a oneliner, read each field in from a prompt.
- ;; Here, prefil the field with its current value.
+ (let ((ol (if draftp (fetch-draft ident) (the-oneliner ident))))
(let* ((oneliner-string
(prompt "Oneliner: "
:expect 'valid-oneliner-string-p
@@ -184,13 +223,23 @@ running the body. If such a oneliner can be found."
:expect 'valid-oneliner-name-p
:retry-text "Must begin with a letter contain only letters, numbers, - and _."
:prefill (or (oneliner-name ol) ""))))
+
+ (draft-name
+ (unless (y-or-n-p "Upload edits immediately instead of keeping a draft?")
+ (if (plusp (length name))
+ name
+ (prompt "No name was provided, name this draft: "
+ :expect 'valid-oneliner-name-p
+ :retry-text "Must begin with a letter contain only letters, numbers, - and _."))))
(brief
(prompt "Brief Description: "
:expect 'valid-brief-description-p
:retry-text "Too long. Must be <= 72 characters: "
:prefill (oneliner-brief ol)))
+
(init-tags
(parse-oneliner-tags oneliner-string))
+
(tags
(progn
(format t "Tags include: ~{~a ~}~%" init-tags)
@@ -208,49 +257,93 @@ running the body. If such a oneliner can be found."
:expect 'valid-runstyle-p
:retry-text "Must be (auto or manual): "
:prefill (oneliner-runstyle ol))))
+
(explanation
- (when (y-or-n-p "Provide an explanation?")
+ (when (y-or-n-p "Alter the explanation?")
(string-from-editor (oneliner-explanation ol)))))
- (let ((new-item
- (list :oneliner oneliner-string
- :tags tags
- :brief brief
- :name (if (plusp (length name)) name :null)
- :explanation explanation
- :runstyle runstyle)))
- (api:request-with
- (:body (jonathan:to-json new-item)
- :content-type "application/json")
+
+ (let ((local
+ (make-oneliner
+ :id (oneliner-id ol)
+ :oneliner oneliner-string
+ :name (if (plusp (length name)) name :null)
+ :tags tags
+ :brief brief
+ :explanation explanation
+ :runstyle runstyle)))
+ (if draft-name
+ (progn
+ (put-draft draft-name local)
+ (format t "Saved draft ~a~%Do `ol --draft run ~a` to test~%"
+ draft-name
+ draft-name))
+ (api:request-with
+ (:body (oneliner-to-json-body local)
+ :content-type "application/json")
+ (api:patch--oneliner-entry-edit (oneliner-id ol) :token (api-token))
+ ;(merge-oneliners (list new-item)) ;;TODO: this is broken, wait for API update.
+ (format t "Edits accepted~%")))))))
+
+;;TODO: need to sync cache here.
+(defun publish-draft (name)
+ (when-draft (ol name)
+ (api:request-with
+ (:body (oneliner-to-json-body ol)
+ :content-type "application/json")
+ (if (oneliner-id ol)
(api:patch--oneliner-entry-edit (oneliner-id ol) :token (api-token))
- (merge-oneliners (list new-item)) ;;TODO: this is broken, wait for API update.
- (format t "OK~%"))))))
+ (api:post--oneliner :token (api-token)))
+ ;; if that worked, no http error occured, so this next part will run
+ (drop-draft name)
+ (format t "Draft ~a published and removed from drafts.~%" name))))
;;; ADMIN OF ONELINER ENTRIES
+(defun delete-item (ident)
+ (when-oneliner (ol ident)
+ (api:delete--oneliner-oneliner
+ ident
+ :token (api-token))
+ ;; if we've made it this far no http error has been returned,
+ ;; hence we can delete it from the cache
+ (remove-from-cache ident)))
+
(defun flag-item (ident)
+ (when-oneliner (ol ident)
+ (api:put--oneliner-entry-flag
+ ident
+ :token (api-token)
+ :value "true")
+ ;; no http error, so we flag the cached version, ol.
+ (setf (oneliner-isflagged ol) t)))
+
+(defun unflag-item (ident)
+ (when-oneliner (ol ident)
+ (api:put--oneliner-entry-flag
+ ident
+ :token (api-token)
+ :value "false")
+ ;; no http error, so we can unflag the cached version, ol
+ (setf (oneliner-isflagged ol) nil)))
+
+(defun lock-item (ident)
+ (when-oneliner (ol ident)
+ (api:put--oneliner-oneliner-locked
+ ident
+ :token (api-token)
+ :value "true")
+ ;; no http error, so we can lock the cached version, ol
+ (setf (oneliner-islocked ol) t)))
+
+(defun unlock-item (ident)
(when-oneliner (ol ident)
- (api:put--oneliner-entry-flag (oneliner-id ol)
- :token (api-token)
- :value "true")))
-
-(defun unflag-item (item-number)
- (when-oneliner (ol item-number)
- (api:put--oneliner-entry-flag (oneliner-id ol)
- :token (api-token)
- :value "false")))
-
-(defun lock-item (item-number)
- (when-oneliner (ol item-number)
- (api:put--oneliner-oneliner-locked (oneliner-id ol)
- :token (api-token)
- :value "true")))
-
-(defun unlock-item (item-number)
- (when-oneliner (ol item-number)
- (api:put--oneliner-oneliner-locked (oneliner-id ol)
- :token (api-token)
- :value "false")))
+ (api:put--oneliner-oneliner-locked
+ ident
+ :token (api-token)
+ :value "false")
+ ;; no http error, so we can unlock the cached version, ol
+ (setf (oneliner-islocked ol) nil)))
;;; ACCOUNT AND INVITE STUFF
diff --git a/lib/oneliner.lisp b/lib/oneliner.lisp
index 4828b2d..668a82c 100644
--- a/lib/oneliner.lisp
+++ b/lib/oneliner.lisp
@@ -94,3 +94,18 @@
(string-trim '(#\space)
(alexandria-2:subseq* (oneliner-brief ol) x (+ x *term-width*)))))
(format t "~%~a~%~%" (oneliner-oneliner ol))))
+
+;;;; json serialization
+
+(defun oneliner-to-json-body (ol)
+ "Takes a oneliner structure and produces some json suitable for
+sending to the server. ID and some other fields are omitted."
+ (jonathan:to-json
+ (list :oneliner (oneliner-oneliner ol)
+ :tags (oneliner-tags ol)
+ :brief (oneliner-brief ol)
+ :name (if (plusp (length (oneliner-name ol)))
+ (oneliner-name ol)
+ :null)
+ :explanation (oneliner-explanation ol)
+ :runstyle (oneliner-runstyle ol))))
diff --git a/lib/package.lisp b/lib/package.lisp
index cf1fbcb..6359b12 100644
--- a/lib/package.lisp
+++ b/lib/package.lisp
@@ -36,4 +36,19 @@
(#:a #:alexandria))
(:export #:with-local-state
#:search-for-oneliners
- #:the-oneliner))
+ #:the-oneliner
+ #:run-item
+ #:print-item-explanation
+ #:add-new-oneliner
+ #:edit-item
+ #:flag-item
+ #:unflag-item
+ #:lock-item
+ #:unlock-item
+ #:redeem-invite
+ #:request-invite-code
+ #:change-pw
+ #:revoke-access
+ #:change-signature
+ #:show-contributor
+ #:login))
diff --git a/lib/state.lisp b/lib/state.lisp
index 0f69ff3..5ca5a7b 100644
--- a/lib/state.lisp
+++ b/lib/state.lisp
@@ -25,7 +25,7 @@
(host "")
(shell "bash"))
-;;; DYNAMIC VARS FOR CONFIG AND CACHE, AND SOME GETTERS
+;;; CONFIG VAR AND OPERATIONS
(defvar *config* nil
"Holds a config struct instance.")
@@ -50,9 +50,58 @@
(defun shell ()
(config-shell *config*))
+
+;;; CACHE VAR AND OPERATIONS
+
(defvar *cache* nil
"Holds cached oneliners as a list.")
+(defun merge-oneliners (new)
+ "Modifies *CACHE*. Merge updated oneliners into the *cache*, ensuring to remove old versions."
+ (setf *cache*
+ (nconc
+ new
+ (delete-if
+ (lambda (old-oneliner)
+ (find (oneliner-id old-oneliner)
+ new
+ :key #'oneliner-id
+ :test #'equal))
+ *cache*))))
+
+(defun get-cached (id-or-name)
+ "Looks up a oneliner instance by ID-OR-NAME using the current binding of *cache*. "
+ (find id-or-name
+ *cache*
+ :key (etypecase id-or-name
+ (integer #'oneliner-id)
+ (string #'oneliner-name))
+ :test #'equal))
+
+(defun remove-from-cache (id-or-name)
+ "Removes an item from the contents of *cache*."
+ (a:when-let (found (get-cached id-or-name))
+ (setf *cache* (delete found *cache*))))
+
+;;; DRAFTS VAR AND OPERATIONS
+
+(defvar *drafts* nil
+ "Holds a list of oneliner drafts yet to be sent to the server.")
+
+(defun fetch-draft (name)
+ "Fetch a draft by name form the *DRAFTS* association list."
+ (cdr (assoc name *drafts* :test #'string-equal)))
+
+(defun drop-draft (name)
+ "Drop a draft by NAME from the *DFRAFTS* association list."
+ (setf *DRAFTS* (delete (assoc name *DRAFTS* :test #'string-equal) *DRAFTS*)))
+
+(defun put-draft (name draft)
+ "Modifies *DRAFTS*, adding a new DRAFT associated with NAME. If NAME
+is already associated, that old association is deleted."
+ (drop-draft name)
+ (push (cons name draft) *drafts*))
+
;;; LOADING AND SAVING STATE
(defun config-file ()
@@ -63,6 +112,10 @@
"Returns the pathname holding the location of the cache."
(merge-pathnames ".cache/oneliners.cache" (user-homedir-pathname)))
+(defun drafts-file ()
+ "Returns the pathame holding the location of the oneliner drafts file."
+ (merge-pathnames ".cache/oneliners.drafts" (user-homedir-pathname)))
+
(defun wipe-cache ()
"Deletes the cache, if present."
(uiop:delete-file-if-exists (cached-oneliners-file)))
@@ -94,6 +147,12 @@ CACHED-ONELINERS-FILE. NIL if there is no such file."
:shell (prompt "With which shell should oneliners be run? "
:prefill "bash")))
+(defun read-drafts-file ()
+ (read-from-file (drafts-file)))
+
+(defun write-drafts-to-disk ()
+ (print-to-file *drafts* (drafts-file)))
+
(defun ensure-config ()
"Ensures that a configuration file exists on disk, prompting the
user for some input if it does not."
@@ -101,29 +160,6 @@ user for some input if it does not."
(read-config-file)
(make-fresh-config)))
-;;; GETTING AND SETTING STATE, DYNAMICALLY BOUND
-
-(defun merge-oneliners (new)
- "Modifies *CACHE*. Merge updated oneliners into the *cache*, ensuring to remove old versions."
- (setf *cache*
- (nconc
- new
- (delete-if
- (lambda (old-oneliner)
- (find (oneliner-id old-oneliner)
- new
- :key #'oneliner-id
- :test #'equal))
- *cache*))))
-
-(defun get-cached (id-or-name)
- "Looks up a oneliner instance by ID-OR-NAME using the current binding of *cache*. "
- (find id-or-name
- *cache*
- :key (etypecase id-or-name
- (integer #'oneliner-id)
- (string #'oneliner-name))
- :test #'equal))
;;; STATE LOADING MACRO
@@ -132,13 +168,15 @@ user for some input if it does not."
sets the api's *host* variable. If BODY produces no errors, the "
`(let* ((*config* (ensure-config))
(*cache* (read-cache-file))
+ (*drafts* (read-drafts-file))
(api:*host* (config-host *config*)))
- (assert api:*host* () "ol must be configured with a server host.")
- (set-term-width)
(handler-case
(progn
+ (assert api:*host* () "ol must be configured with a server host.")
+ (set-term-width)
,@body
;; only if there is no error do we save the local state.
+ (write-drafts-to-disk)
(write-cache-to-disk)
(write-config-to-disk))
(error (e)