diff options
| -rw-r--r-- | app/app.lisp | 173 | ||||
| -rw-r--r-- | clpmfile.lock | 7 | ||||
| -rw-r--r-- | lib/client.lisp | 656 | ||||
| -rw-r--r-- | lib/oneliner.lisp | 4 | ||||
| -rw-r--r-- | lib/package.lisp | 7 | ||||
| -rw-r--r-- | lib/state.lisp | 57 | ||||
| -rw-r--r-- | lib/util.lisp | 9 |
7 files changed, 427 insertions, 486 deletions
diff --git a/app/app.lisp b/app/app.lisp index fea4aa3..28f5465 100644 --- a/app/app.lisp +++ b/app/app.lisp @@ -16,7 +16,6 @@ ;; along with this program. If not, see <http://www.gnu.org/licenses/>. - (in-package :oneliners.cli.app) ;;; VERSION @@ -196,95 +195,85 @@ than the users." (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 ; 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"))))) - (uiop:quit)) - - (t ; no arguments and no options, print help - (help))) - (uiop:quit)) - (error (e) - (format *error-output* "~%ERROR: ~a~%" e) - (uiop:quit)) - (#+sbcl sb-sys:interactive-interrupt - #+ccl ccl:interrupt-signal-condition - () - (format t "Aborted by User Interrupt.~%") + (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)) + (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 ; 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))) (uiop:quit)))) diff --git a/clpmfile.lock b/clpmfile.lock index 76e1373..6e77eea 100644 --- a/clpmfile.lock +++ b/clpmfile.lock @@ -75,7 +75,7 @@ ("oneliners.api-client.asd" :version :newest :source :implicit-file :systems ("oneliners.api-client")) ("oneliners.cli.asd" :version :newest :source :implicit-file :systems - ("oneliners.cli")) + ("oneliners.cli" "oneliners.cli/app")) ("proc-parse" :version "2019-08-13" :source "quicklisp" :systems ("proc-parse")) ("quri" :version "2021-06-30" :source "quicklisp" :systems ("quri")) ("smart-buffer" :version "2021-10-21" :source "quicklisp" :systems @@ -154,6 +154,7 @@ ("cl-change-case" ((:system :name "str") (:system :name "cl-change-case"))) ("cl-clon" + ((:system :name "oneliners.cli/app") (:system :name "net.didierverna.clon")) ((:system :name "oneliners.cli") (:system :name "net.didierverna.clon")) ((:system :name "net.didierverna.clon.termio") (:system :name "net.didierverna.clon.core")) @@ -225,7 +226,9 @@ ((:system :name "oneliners.cli") (:system :name "oneliners.api-client")) (t (:asd-file :name "oneliners.api-client.asd"))) -("oneliners.cli.asd" (t (:asd-file :name "oneliners.cli.asd"))) +("oneliners.cli.asd" + ((:system :name "oneliners.cli/app") (:system :name "oneliners.cli")) + (t (:asd-file :name "oneliners.cli.asd"))) ("proc-parse" ((:system :name "jonathan") (:system :name "proc-parse")) ((:system :name "fast-http") (:system :name "proc-parse")) diff --git a/lib/client.lisp b/lib/client.lisp index 22d75b8..2753329 100644 --- a/lib/client.lisp +++ b/lib/client.lisp @@ -16,17 +16,31 @@ ;; along with this program. If not, see <http://www.gnu.org/licenses/>. (in-package :oneliners.cli) -;;; UTILITIES +;; 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. -(defun cache-and-print-search-response (json) - "Takes a json string and parses it. Using the parse results, create -ONELINER instances. Print those using PRINT-ONELINER-RESULT-FOR-USER -and then ensure the cache is updated." - (merge-oneliners - (loop for oneliner-plist in (getf (jonathan:parse json) :oneliners) - for oneliner = (apply #'make-oneliner oneliner-plist) - collect oneliner - do (print-oneliner-result-for-user oneliner)))) +;;; GETTING 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.") + (let ((json + (api:get--oneliners :tags (str:join "," terms) + :limit limit + :notflagged (true-or-false not-flagged-p) + :newest (true-or-false newestp) + :onlyflagged (true-or-false all-flagged-p)))) + (cache-and-print-search-response json))) + +(defun the-oneliner (name-or-id) + "Get the oneliner with name-or-id. First look in the local cache. If +not in the local cache, try to fetch from configured server." + (a:if-let ((ol (get-cached name-or-id))) + ol + (let ((ol (jonathan:parse (api:get--oneliner-entry name-or-id)))) + (merge-oneliners (list ol)) + ol))) (defmacro when-oneliner ((var name-or-id) &body body) "Finds the oneliner with name-or-id and binds it to var before @@ -37,40 +51,28 @@ running the body. If such a oneliner can be found." (a:when-let (,var (the-oneliner ,nvar)) ,@body)))) +(defun newest-oneliners (&optional limit) + (let ((response + (if limit + (api:get--oneliners-newest :limit limit) + (api:get--oneliners-newest)))) + (cache-and-print-search-response response))) -;;; SEARCHING FOR 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.") - (with-local-state - (let ((json - (api:get--oneliners :tags (str:join "," terms) - :limit limit - :notflagged (true-or-false not-flagged-p) - :newest (true-or-false newestp) - :onlyflagged (true-or-false all-flagged-p)))) - (cache-and-print-search-response json)))) - -(defun the-oneliner (name-or-id) - "Get the oneliner with name-or-id. First look in the local cache. If -not in the local cache, try to fetch from configured server." - (with-local-state - (a:if-let ((ol (get-cached name-or-id))) - ol - (let ((ol (jonathan:parse (api:get--oneliner-entry name-or-id)))) - (merge-oneliners (list ol)) - ol)))) - +(defun all-flagged-oneliners (&optional limit) + (let ((response + (if limit + (api:get--oneliners-all-flagged :limit limit) + (api:get--oneliners-all-flagged)))) + (cache-and-print-search-response response))) ;;; RUNNING ONELINERS (defvar *ol-output-timeout* 1) (defun run-item (ident args &key force-clip (timeout nil timeout-p)) - (with-local-state - (when-oneliner (ol ident) - (let ((*ol-output-timeout* (if timeout-p timeout *ol-output-timeout*))) - (bind-vars-and-run-oneliner ol args force-clip))))) + (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 bind-vars-and-run-oneliner (ol args &optional force-clip) (let* ((oneliner (oneliner-oneliner ol)) @@ -104,351 +106,241 @@ not in the local cache, try to fetch from configured server." (princ ol) (princ #\newline) (princ #\newline) - (run-with-shell ol :shell-name (or (config-shell *config*) "bash"))))) + (run-with-shell ol :shell-name (or (shell) "bash"))))) + +;;; 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. + (let* ((oneliner-string + (prompt "Oneliner: " + :expect 'valid-oneliner-string-p + :retry-text "Oneliners must contain at least one command: ")) + (name + (string-trim + '(#\space #\newline #\tab #\linefeed) + (prompt "Name (leave blank for none): " + :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 + :retry-text "Too long. Must be <= 72 characters: ")) + (tags + (progn + (format t "Tags include: ~{~a ~}~%" init-tags) + (append init-tags + (ppcre:split " +" + (prompt "More tags here, or Enter to skip: "))))) + (runstyle + (string-upcase + (prompt "Runstyle (auto or manual): " + :expect 'valid-runstyle-p + :retry-text "Must be (auto or manual): " + :prefill "auto"))) + (explanation + (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~%")))) + +;;; EDITING ONELINERS + +(defun edit-item (ident) + (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* ((oneliner-string + (prompt "Oneliner: " + :expect 'valid-oneliner-string-p + :retry-text "Oneliners must contain at least one command: " + :prefill (oneliner-oneliner ol))) + (name + (string-trim + '(#\space #\newline #\tab #\linefeed) + (prompt "Name (leave blank for none): " + :expect 'valid-oneliner-name-p + :retry-text "Must begin with a letter contain only letters, numbers, - and _." + :prefill (or (oneliner-name ol) "")))) + (brief + (prompt "Brief Description: " + :expect 'valid-brief-description-p + :retry-text "Too long. Must be <= 72 characters: " + :prefill (oneliner-brief ol))) + (init-tags + (tags-from-oneliner oneliner-string)) + (tags + (progn + (format t "Tags include: ~{~a ~}~%" init-tags) + (append init-tags + (ppcre:split " +" + (prompt "More tags here, or Enter to skip: " + :prefill (str:join " " + (set-difference + (oneliner-tags ol) + init-tags + :test 'equal))))))) + (runstyle + (string-upcase + (prompt "Runstyle (auto or manual): " + :expect 'valid-runstyle-p + :retry-text "Must be (auto or manual): " + :prefill (oneliner-runstyle ol)))) + (explanation + (when (y-or-n-p "Provide an explanation?") + (string-from-editor (oneliner-explanation ol))))) + (let ((new-item + (list :oneliner oneliner + :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") + (api:patch--oneliner-entry-edit (oneliner-id ol) :token (api-token)) + (update-cached-item new-item) + (format t "OK~%")))))) + + +;;; ADMIN OF ONELINER ENTRIES + +(defun flag-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"))) + + +;;; ACCOUNT AND INVITE STUFF + +(defun request-invite-code () + (let ((invite (jonathan:parse (api:post--invite :token (api-token))))) + (format t "Invite Code: ~a~%Expires: ~a~%" + (getf invite :code) + (getf invite :expires)))) + +(defun login (user pass) + (let ((response + (jonathan:parse + (api:request-with + (:body (jonathan:to-json (list :password pass :handle user)) + :content-type "application/json") + (api:post--access))))) + (setf (api-token) (getf response :token) + (handle) user) + (format t "Access token written to ~a~%You may now make contributions to the wiki!.~%" + (config-file)))) + +(defun change-pw (current new repeated) + (unless (equal new repeated) + (error "The new password doesn't match the repeated value. Double check.")) + (api:put--contributor-who-password (handle) + :token (api-token) + :value new + :repeated new + :current current)) + +(defun change-signature () + (let ((new-sig + (prompt-for-signature))) + (ensure-config) + (api:request-with + (:host (host) + :body (jonathan:to-json (list :signature new-sig)) + :content-type "application/json") + (api:put--contributor-who-signature (contributor-handle) :token (api-token)) + (format t "Your signature was changed.~%")))) + + +(defun show-contributor (name) + (let ((contributor (api:get--contributor-who name))) + (print-contributor (jonathan:parse contributor)))) + + +(defparameter +agree-to-the-unlicense+ + "By creating this contributor account, I agree that my contributions + be released into the public domain, for the benefit of the public at + large, and to the detriment of my heirs and successors. I intend + this dedication to be an overt act of relinquishment in perpetuity + of all present and future rights to my contributions under software + copyright law copyright law. More specifically, I agree to release all of my + contributions using The Unlicense. (see https://unlicense.org/)") + +(defun redeem-invite (token name pass) + (when (yes-or-no-p +agree-to-the-unlicense+) + (api:request-with + (:body (jonathan:to-json (list :handle name + :password1 pass :password2 pass + :signature (prompt-for-signature))) + :content-type "application/json") + (api:post--invite-redeem-code token) + (format t "Account made for ~a. You may log in now~%" name)))) + +;;TODO: check this .. shouldnt access be a username??? +(defun revoke-access () + (api:delete--access-access (api-token) :token (api-token)) + (format t "You were logged out~%")) + + +;;; UTILITIES + +(defun cache-and-print-search-response (json) + "Takes a json string and parses it. Using the parse results, create +ONELINER instances. Print those using PRINT-ONELINER-RESULT-FOR-USER +and then ensure the cache is updated." + (merge-oneliners + (loop for oneliner-plist in (getf (jonathan:parse json) :oneliners) + for oneliner = (apply #'make-oneliner oneliner-plist) + collect oneliner + do (print-oneliner-result-for-user oneliner)))) + + +(defun prompt-for-signature () + "Just prompt the user for confirmation about whether or not to +change their signature." + (if (y-or-n-p "Provide a contributor signature about yourself? ") + (prompt "Go ahead: ") + "")) + -;; (defun make-fresh-config () -;; (format t "No configuration file has been found. Running Setup~%~%") -;; (setf *config* -;; (make-config -;; :host (prompt "Oneliner Instance Host: " -;; :prefill "https://api.oneliners.wiki") -;; :shell (prompt "With which shell should commands be run: " -;; :prefill "bash"))) -;; (write-config-to-disk) -;; (format t "Configuration has been written to ~a~%. Edit this at any time.~%~%" -;; (config-file))) - -;; (defun fetch-config-from-disk () -;; (let ((conf -;; (uiop:with-safe-io-syntax () -;; (uiop:read-file-form (config-file))))) -;; (assert (valid-config-p conf) () "Invalid configuration file") -;; (setf *config* conf))) - -;; (defun ensure-config () -;; (unless (uiop:file-exists-p (config-file)) -;; (make-fresh-config)) -;; (fetch-config-from-disk)) - - -;; ;;; UTILITIES - - -;; ;; (defun cached-result (n) -;; ;; (when (uiop:file-exists-p (cached-oneliners-file)) -;; ;; (let ((contents (with-open-file (input (cached-oneliners-file)) (read input)))) -;; ;; (etypecase n -;; ;; (integer -;; ;; (find n contents :key (lambda (x) (getf x :id)))) -;; ;; (string -;; ;; (find n contents :key (lambda (x) (getf x :name)) :test #'equal)))))) - - - - - - - -;; ;;; API REQUEST FUNCTIONS - -;; (defun the-oneliner (name-or-id) -;; "Get the oneliner with name-or-id. Try to fetch from local cache, -;; and, failing that, try to fetch from configured server." -;; (a:if-let ((ol (cached-result name-or-id))) -;; ol -;; (progn -;; (ensure-config) -;; (a:when-let (ol -;; (api:request-with (:host (host)) -;; (jonathan:parse -;; (api:get--oneliner-entry name-or-id)))) -;; (merge-into-cache (list ol)) -;; ol)))) - -;; (defun flag-item (ident) -;; (with-oneliner (ol ident) -;; (ensure-config) -;; (api:request-with -;; (:host (host)) -;; (api:put--oneliner-entry-flag (getf ol :id) :token (api-token) :value "true")))) - -;; (defun unflag-item (item-number) -;; (with-oneliner (ol item-number) -;; (ensure-config) -;; (api:request-with -;; (:host (host)) -;; (api:put--oneliner-entry-flag (getf ol :id) :token (api-token) :value "false")))) - -;; (defun lock-item (item-number) -;; (with-oneliner (ol item-number) -;; (ensure-config) -;; (api:request-with -;; (:host (host)) -;; (api:put--oneliner-oneliner-locked (getf ol :id) :token (api-token) :value "true")))) - -;; (defun unlock-item (item-number) -;; (with-oneliner (ol item-number) -;; (ensure-config) -;; (api:request-with -;; (:host (host)) -;; (api:put--oneliner-oneliner-locked (getf ol :id) :token (api-token) :value "false")))) - - - -;; ;;; PRINTING ONELINERS - - -;; (defun print-item-explanation (name-or-number) -;; (with-oneliner (ol name-or-number) -;; (set-term-width) -;; (print-oneliner-result-for-user ol) -;; (a:when-let (explanation (getf ol :explanation)) -;; (format t "EXPLANATION:~%~%") -;; (princ -;; (string-trim -;; '(#\newline #\space #\tab) -;; (if (str:starts-with? (getf ol :oneliner) explanation) -;; (subseq explanation (length (getf ol :oneliner))) -;; explanation))) -;; (terpri)))) - -;; (defun tags-from-oneliner (string) -;; "Splits a string using consequitive whitespace as a separator, -;; returning a set of tags" -;; (remove-duplicates -;; (remove-if-not #'executable-on-system-p (ppcre:split " +" string)) -;; :test #'equal)) - - -;; (defun add-new-oneliner () -;; (ensure-config) -;; (assert (api-token) () "Cannot add a oneliner without an api token.") -;; (let* ((oneliner -;; (prompt "Oneliner: " -;; :expect 'valid-oneliner-string-p -;; :retry-text "Oneliners must contain at least one command: ")) -;; (name -;; (string-trim -;; '(#\space #\newline #\tab #\linefeed) -;; (prompt "Name (leave blank for none): " -;; :expect 'valid-oneliner-name-p -;; :retry-text "Must begin with a letter contain only letters, numbers, - and _."))) -;; (init-tags -;; (tags-from-oneliner oneliner)) -;; (brief -;; (prompt "Brief Description: " -;; :expect 'valid-brief-description-p -;; :retry-text "Too long. Must be <= 72 characters: ")) -;; (tags -;; (progn -;; (format t "Tags include: ~{~a ~}~%" init-tags) -;; (append init-tags -;; (ppcre:split " +" -;; (prompt "More tags here, or Enter to skip: "))))) -;; (runstyle -;; (string-upcase -;; (prompt "Runstyle (auto or manual): " -;; :expect 'valid-runstyle-p -;; :retry-text "Must be (auto or manual): " -;; :prefill "auto"))) -;; (explanation -;; (when (y-or-n-p "Provide an explanation?") -;; (string-from-editor -;; (format nil "~a~%~%" oneliner))))) -;; (api:request-with -;; (:host (host) -;; :body (jonathan:to-json -;; (list :oneliner oneliner -;; :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)) -;; (format t "Added~%")))) - -;; (defun edit-item (ident) -;; (with-oneliner (ol ident) -;; (ensure-config) -;; (assert (api-token) () "Cannot edit a oneliner without an api token.") -;; (let* ((oneliner -;; (prompt "Oneliner: " -;; :expect 'valid-oneliner-string-p -;; :retry-text "Oneliners must contain at least one command: " -;; :prefill (getf ol :oneliner))) -;; (name -;; (string-trim -;; '(#\space #\newline #\tab #\linefeed) -;; (prompt "Name (leave blank for none): " -;; :expect 'valid-oneliner-name-p -;; :retry-text "Must begin with a letter contain only letters, numbers, - and _." -;; :prefill (if (getf ol :name) (getf ol :name) "")))) -;; (brief -;; (prompt "Brief Description: " -;; :expect 'valid-brief-description-p -;; :retry-text "Too long. Must be <= 72 characters: " -;; :prefill (getf ol :brief))) -;; (init-tags -;; (tags-from-oneliner oneliner)) -;; (tags -;; (progn -;; (format t "Tags include: ~{~a ~}~%" init-tags) -;; (append init-tags -;; (ppcre:split " +" -;; (prompt "More tags here, or Enter to skip: " -;; :prefill (str:join " " -;; (set-difference -;; (getf ol :tags) -;; init-tags -;; :test 'equal))))))) -;; (runstyle -;; (string-upcase -;; (prompt "Runstyle (auto or manual): " -;; :expect 'valid-runstyle-p -;; :retry-text "Must be (auto or manual): " -;; :prefill (getf ol :runstyle)))) -;; (explanation -;; (when (y-or-n-p "Provide an explanation?") -;; (string-from-editor (getf ol :explanation))))) -;; (let ((new-item -;; (list :oneliner oneliner -;; :tags tags -;; :brief brief -;; :name (if (plusp (length name)) name :null) -;; :explanation explanation -;; :runstyle runstyle))) -;; (api:request-with -;; (:host (host) -;; :body (jonathan:to-json -;; new-item) -;; :content-type "application/json") -;; (api:patch--oneliner-entry-edit (getf ol :id) :token (api-token)) -;; (update-cached-item new-item) -;; (format t "OK~%")))))) - -;; (defun request-invite-code () -;; (ensure-config) -;; (api:request-with -;; (:host (host)) -;; (let ((invite (jonathan:parse (api:post--invite :token (api-token))))) -;; (format t "Invite Code: ~a~%Expires: ~a~%" -;; (getf invite :code) -;; (getf invite :expires))))) - -;; (defun login (user pass) -;; (ensure-config) -;; (a:when-let (response (jonathan:parse -;; (api:request-with -;; (:host (host) -;; :body (jonathan:to-json (list :password pass :handle user)) -;; :content-type "application/json") -;; (api:post--access)))) -;; (setf (api-token) (getf response :token) -;; (contributor-handle) user) -;; (write-config-to-disk) -;; (format t "Access token written to ~a~%You may now make contributions to the wiki!.~%" -;; (config-file)))) - -;; (defun change-pw (current new repeated) -;; (unless (equal new repeated) -;; (error "The new password doesn't match the repeated value. Double check.")) -;; (ensure-config) -;; (api:request-with -;; (:host (host)) -;; (api:put--contributor-who-password (contributor-handle) -;; :token (api-token) -;; :value new -;; :repeated new -;; :current current))) - -;; (defparameter +agree-to-the-unlicense+ -;; "By creating this contributor account, I agree that my contributions -;; be released into the public domain, for the benefit of the public at -;; large, and to the detriment of my heirs and successors. I intend -;; this dedication to be an overt act of relinquishment in perpetuity -;; of all present and future rights to my contributions under software -;; copyright law copyright law. More specifically, I agree to release all of my -;; contributions using The Unlicense. (see https://unlicense.org/)") - - -;; (defun prompt-for-signature () -;; (if (y-or-n-p "Provide a contributor signature about yourself? ") -;; (prompt "Go ahead: ") -;; "")) - -;; (defun change-signature () -;; (let ((new-sig -;; (prompt-for-signature))) -;; (ensure-config) -;; (api:request-with -;; (:host (host) -;; :body (jonathan:to-json (list :signature new-sig)) -;; :content-type "application/json") -;; (api:put--contributor-who-signature (contributor-handle) :token (api-token)) -;; (format t "Your signature was changed.~%")))) - -;; (defun print-contributor (contributor) -;; (format t "~20a ~@[-- ~a~]~%" -;; (getf contributor :handle) -;; (getf contributor :signature))) - -;; (defun show-contributor (name) -;; (ensure-config) -;; (api:request-with -;; (:host (host)) -;; (a:when-let (contributor -;; (api:get--contributor-who name)) -;; (print-contributor (jonathan:parse contributor))))) - -;; (defun redeem-invite (token name pass) -;; (ensure-config ) -;; (when (yes-or-no-p +agree-to-the-unlicense+) -;; (api:request-with -;; (:host (host) -;; :body (jonathan:to-json (list :handle name -;; :password1 pass :password2 pass -;; :signature (prompt-for-signature))) -;; :content-type "application/json") -;; (api:post--invite-redeem-code token) -;; (format t "Account made for ~a. You may log in now~%" name)))) - -;; ;;TODO: check this .. shouldnt access be a username??? -;; (defun revoke-access () -;; (ensure-config) -;; (api:request-with -;; (:host (host)) -;; (api:delete--access-access (api-token) :token (api-token)) -;; (format t "You were logged out~%"))) - -;; (defun update-cached-item (item) -;; (merge-into-cache (list item))) - - - - -;; (defun newest-oneliners (&optional limit) -;; (ensure-config) -;; (api:request-with -;; (:host (host)) -;; (let ((response -;; (if limit -;; (api:get--oneliners-newest :limit limit) -;; (api:get--oneliners-newest)))) -;; (cache-and-print-search-response response)))) - -;; (defun all-flagged-oneliners (&optional limit) -;; (ensure-config) -;; (api:request-with -;; (:host (host)) -;; (let ((response -;; (if limit -;; (api:get--oneliners-all-flagged :limit limit) -;; (api:get--oneliners-all-flagged)))) -;; (cache-and-print-search-response response)))) - - - -;; ;;; RUNNING THINGS IN THE SHELL. +(defun print-contributor (contributor) + (format t "~20a ~@[-- ~a~]~%" + (getf contributor :handle) + (getf contributor :signature))) diff --git a/lib/oneliner.lisp b/lib/oneliner.lisp index ccfd3dc..39aad0d 100644 --- a/lib/oneliner.lisp +++ b/lib/oneliner.lisp @@ -48,11 +48,13 @@ (ppcre:all-matches-as-strings "#[A-Za-z][A-Za-z0-9_]*" (oneliner-oneliner ol)) :test #'equal)) + + ;;; VALIDATION OF ONELINER SLOT VALUES (defun valid-oneliner-string-p (string) (and (not (find #\newline string)) - (tags-from-oneliner string))) + (parse-oneliner-tags string))) (defun valid-brief-description-p (string) (<= (length string) 72)) diff --git a/lib/package.lisp b/lib/package.lisp index 0ed47b0..cf1fbcb 100644 --- a/lib/package.lisp +++ b/lib/package.lisp @@ -20,7 +20,7 @@ (defpackage #:oneliners.cli.term (:use #:cl) - (:export #:*term-width*)) + (:export #:*term-width* #:set-term-width)) (defpackage #:oneliners.cli.prompt (:use #:cl) @@ -33,4 +33,7 @@ (:import-from #:oneliners.cli.term #:*term-width* #:set-term-width) (:import-from #:oneliners.cli.running #:run-with-shell) (:local-nicknames (#:api #:oneliners.api-client) - (#:a #:alexandria))) + (#:a #:alexandria)) + (:export #:with-local-state + #:search-for-oneliners + #:the-oneliner)) diff --git a/lib/state.lisp b/lib/state.lisp index 0c01d4d..676ff10 100644 --- a/lib/state.lisp +++ b/lib/state.lisp @@ -20,14 +20,36 @@ ;;; Config Struct (defstruct config - handle - api-token - host - shell) + (handle "") + (api-token "") + (host "") + (shell "bash")) + +;;; DYNAMIC VARS FOR CONFIG AND CACHE, AND SOME GETTERS (defvar *config* nil "Holds a config struct instance.") +(defun api-token () + (a:if-let (token (config-api-token *config*)) + token + (error () "No API TOKEN"))) + +(defun (setf api-token) (newvalue) + (setf (config-api-token *config*) newvalue)) + +(defun handle () + (config-handle *config*)) + +(defun (setf handle) (newvalue) + (setf (config-handle *config*) newvalue)) + +(defun host () + (config-host *config*)) + +(defun shell () + (config-shell *config*)) + (defvar *cache* nil "Holds cached oneliners as a list.") @@ -46,7 +68,10 @@ (uiop:delete-file-if-exists (cached-oneliners-file))) (defun write-config-to-disk () - (print-to-file *config* (config-file))) + (print-to-file + (with-slots (handle api-token host shell) *config* + (list :handle handle :api-token api-token :host host :shell shell)) + (config-file))) (defun write-cache-to-disk () (print-to-file *cache* (cached-oneliners-file))) @@ -54,13 +79,31 @@ (defun read-config-file () "Read a configuration from the location returned by CONFIG-FILE. NIL if there is no such file" - (read-from-file (config-file))) + (a:when-let ((conf + (read-from-file (config-file)))) + (apply 'make-config conf))) (defun read-cache-file () "Read the cache from the location returned by CACHED-ONELINERS-FILE. NIL if there is no such file." (read-from-file (cached-oneliners-file))) +(defun make-fresh-config () + "Prompts the user to supply some values for a config file." + (format t "It seems you are calling `ol` for the first time. Running Setup~%~%") + (make-config + :host (prompt "Oneliner Server Host: " + :prefill "https://api.oneliners.wiki") + :shell (prompt "With which shell should oneliners be run? " + :prefill "bash"))) + +(defun ensure-config () + "Ensures that a configuration file exists on disk, prompting the +user for some input if it does not." + (if (uiop:file-exists-p (config-file)) + (read-config-file) + (make-fresh-config))) + ;;; GETTING AND SETTING STATE, DYNAMICALLY BOUND (defun merge-oneliners (new) @@ -90,7 +133,7 @@ CACHED-ONELINERS-FILE. NIL if there is no such file." (defmacro with-local-state (&body body) "Binds the *config* and *cache* dynamic variables from disk, and sets the api's *host* variable. If BODY produces no errors, the " - `(let* ((*config* (read-config-file)) + `(let* ((*config* (ensure-config)) (*cache* (read-cache-file)) (api:*host* (config-host *config*))) (assert api:*host* () "ol must be configured with a server host.") diff --git a/lib/util.lisp b/lib/util.lisp index 2a6d456..27f389e 100644 --- a/lib/util.lisp +++ b/lib/util.lisp @@ -46,6 +46,14 @@ the directories that appear in the value of that variable." thereis (uiop:file-exists-p (make-pathname :name name :directory directory)))) +(defun parse-oneliner-tags (string) + "Splits a string using consequtive whitespace as a separator, and +returns a set of strings that name executable system commands, as +determined by EXECUTABLE-ON-SYSTEM-P." + (remove-duplicates + (remove-if-not #'executable-on-system-p (ppcre:split " +" string)) + :test #'equal)) + (defun print-to-file (printable-object pathname &optional (if-exists :supersede)) "Prints an object to a file, ensuring that the containing directory exists first." (ensure-directories-exist pathname) @@ -61,3 +69,4 @@ the directories that appear in the value of that variable." (defun true-or-false (what) "Returns the strings \"true\" or \"false\" depending on whehter or not WHAT is null" (if what "true" "false")) + |