aboutsummaryrefslogtreecommitdiff
path: root/src/lib.lisp
diff options
context:
space:
mode:
authorColin Okay <okay@toyful.space>2022-03-11 08:35:55 -0600
committerColin Okay <okay@toyful.space>2022-03-11 08:35:55 -0600
commit08ba2769abb7a36817a725d30d64cfd36f5bcf32 (patch)
tree3068a5d9e1a4afd06a5f8b236658d4094e30dfef /src/lib.lisp
parent62afeb3f21d3d8e8db045a001271e686e944a049 (diff)
separated app and lib modules, -osicat dep, +packages.lisp
Diffstat (limited to 'src/lib.lisp')
-rw-r--r--src/lib.lisp622
1 files changed, 0 insertions, 622 deletions
diff --git a/src/lib.lisp b/src/lib.lisp
deleted file mode 100644
index 4e1630e..0000000
--- a/src/lib.lisp
+++ /dev/null
@@ -1,622 +0,0 @@
-;;;; main.lisp -- oneliners.cli entrypoint
-
-;; 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
- (:use :cl)
- (:import-from #:oneliners.cli.prompt #:prompt)
- (:local-nicknames (#:api #:oneliners.api-client)
- (#:a #:alexandria)))
-
-(in-package :oneliners.cli)
-
-;;; CONFIG AND RESULTS FILE LOCATIONS
-
-(defvar *config* nil
- "A configuration plist")
-
-(defvar *ol-output-timeout* 1)
-
-(defun ensure-local-state ()
- (ensure-config)
- (setf api::*host* (getf *config* :host)))
-
-
-(defun valid-config-p (config)
- (and (listp config)
- (evenp (length config))
- (stringp (getf config :host))
- t))
-
-(defun write-config-to-disk ()
- (let ((conf-file (config-file)))
- (ensure-directories-exist conf-file)
- (with-open-file (out conf-file :direction :output :if-exists :supersede)
- (print *config* out))))
-
-(defun make-config (&key host api-token editor (shell "bash"))
- (append (when host (list :host host))
- (when api-token (list :api-token api-token))
- (list :shell shell)))
-
-(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))
-
-(defun host () (getf *config* :host))
-(defun api-token () (getf *config* :api-token))
-(defun (setf api-token) (newval)
- (setf (getf *config* :api-token) newval))
-(defun get-shell ()
- (getf *config* :shell))
-(defun contributor-handle () (getf *config* :handle))
-(defun (setf contributor-handle) (newval)
- (setf (getf *config* :handle) newval))
-
-(defun config-file ()
- (merge-pathnames ".config/oneliners.config" (user-homedir-pathname)))
-
-(defun cached-oneliners-file ()
- (merge-pathnames ".cache/cached_oneliners" (user-homedir-pathname)))
-
-(defun wipe-cache ()
- (uiop:delete-file-if-exists (cached-oneliners-file)))
-
-(defun merge-into-cache (new-ols)
- (let* ((cached
- (when (uiop:file-exists-p (cached-oneliners-file))
- (with-open-file (input (cached-oneliners-file)) (read input))))
- (updated
- (append
- new-ols
- (loop for old in cached
- for id = (getf old :id)
- unless (find id new-ols :key (lambda (x) (getf x :id)))
- collect old))))
- (ensure-directories-exist (cached-oneliners-file))
- (with-open-file (output (cached-oneliners-file) :direction :output :if-exists :supersede)
- (print updated output))))
-
-;;; UTILITIES
-(defun make-temp-file-name ()
- (namestring
- (merge-pathnames (format nil "~a" (gensym "oneliners")) (uiop:temporary-directory))))
-
-(defun string-from-editor (&optional contents)
- (let ((filename (make-temp-file-name)))
- (when contents (a:write-string-into-file contents filename :if-exists :supersede))
- (unwind-protect
- (magic-ed:magic-ed filename :eval nil :output :string)
- (uiop:delete-file-if-exists filename))))
-
-(defun executable-on-system-p (name)
- "A hack that heuristically determins whether or not an executable
-with the provided name is on the system. It is not perfect. It
-consults the environment PATH, and looks for the command in any of
-the directories that appear in the value of that variable."
- #+unix
- (loop for path in (str:split ":" (uiop:getenv "PATH"))
- for directory = (cons :absolute
- (cdr (str:split "/" path)))
- thereis (uiop:file-exists-p
- (make-pathname :name name :directory directory))))
-
-(defun tags-from-oneliner (oneliner)
- (remove-duplicates
- (remove-if-not #'executable-on-system-p (ppcre:split " +" oneliner))
- :test #'equal))
-
-
-
-
-
-(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))))))
-
-(defmacro with-oneliner ((var name-or-id) &body body)
- (assert (symbolp var))
- (let ((nvar (gensym)))
- `(let ((,nvar ,name-or-id))
- (a:if-let (,var (the-oneliner ,nvar))
- (progn ,@body)
- (format t "Could not find the oneliner specified by ~a~%" ,nvar)))))
-
-(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))))
-
-;;; 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"))))
-
-(defun collect-positional-arguments (oneliner)
- (remove-duplicates
- (sort
- (ppcre:all-matches-as-strings "#[1-9][0-9]*" oneliner)
- #'string<)
- :test #'equal))
-
-(defun collect-named-arguments (oneliner)
- (remove-duplicates
- (ppcre:all-matches-as-strings "#[A-Za-z][A-Za-z0-9_]*" oneliner)
- :test #'equal))
-
-(defun handle-run-oneliner (ol &optional clip)
- (if clip
- (progn (trivial-clipboard:text ol)
- (format t "Copied oneliner to clipboard~%"))
- (progn
- (ensure-config)
- (format t "Attempting to run:~%")
- (princ ol)
- (princ #\newline)
- (princ #\newline)
- (run-with-shell ol :shell-name (or (get-shell) "bash")))))
-
-(defun bind-vars-and-run-oneliner (ol args &optional force-clip)
- (let* ((oneliner (getf ol :oneliner))
- (runstyle (getf ol :runstyle))
- (pos-args (collect-positional-arguments oneliner))
- (named-args (collect-named-arguments oneliner)))
-
- (when (or (not (getf ol :isflagged))
- (y-or-n-p "This oneliner is flagged. Are you sure you want to run it?"))
- ;; 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"))))))
-
-(defun run-item (ident args &key force-clip (timeout nil timeout-p))
- (with-oneliner (ol ident)
- (let ((*ol-output-timeout* (if timeout-p timeout *ol-output-timeout*)))
- (bind-vars-and-run-oneliner ol args force-clip))))
-
-(defun valid-oneliner-string-p (string)
- (and (not (find #\newline string))
- (tags-from-oneliner string)))
-
-(defun valid-brief-description-p (string)
- (<= (length string) 72))
-
-(defun valid-runstyle-p (string)
- (member string '("auto" "manual") :test 'equalp))
-
-(defun valid-oneliner-name-p (string)
- (or (equal string "")
- (and (< 2 (length string))
- (ppcre:scan "^[a-zA-Z][a-zA-Z0-9_\-]+$" string))))
-
-(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)))
-
-(defvar *term-width* nil)
-
-(defun set-term-width ()
- ;; tput cols b/c getenv COLUMNS wasnt working on some terminals
- (setf *term-width*
- (-
- (or (parse-integer (uiop:run-program '("tput" "cols") :output :string) :junk-allowed t)
- 80)
- 4)))
-
-(defun print-oneliner-result-for-user (oneliner)
- (unless *term-width* (set-term-width)) ; setting here as a fallback, can set it elswere if desired.
- (let* ((title-line-format-str
- (concatenate 'string "~" (prin1-to-string *term-width*) "<[~a]~;~a~;~a~>~%"))
- (tags-line-format-string
- (concatenate 'string "~" (prin1-to-string *term-width*) "<~a~;by ~a~>~%")))
- (loop repeat *term-width* do (princ #\_))
- (terpri)
- (format t title-line-format-str
- (getf oneliner :id)
- (or (getf oneliner :name) " ")
- (format nil "~:[ ~;⚠~]~:[ ~;🔒~]~:[ ~;📋~]"
- (getf oneliner :isflagged)
- (getf oneliner :islocked)
- (equalp "manual" (getf oneliner :runstyle))))
- (format t tags-line-format-string
- (format nil "tags: ~{~a~^ ~}"
- (getf oneliner :tags))
- (getf oneliner :createdby))
- (loop
- with brief = (getf oneliner :brief)
- for x from 0 to (length brief) by *term-width*
- do (format t "~a~%"
- (string-trim '(#\space)
- (alexandria-2:subseq* brief x (+ x *term-width*)))))
- (format t "~%~a~%~%" (getf oneliner :oneliner))))
-
-(defun cache-and-print-search-response (response)
- (merge-into-cache
- (loop for oneliner in (getf (jonathan:parse response) :oneliners)
- collect oneliner
- do (print-oneliner-result-for-user oneliner))))
-
-(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))))
-
-(defun search-for-oneliners (terms limit not-flagged-p all-flagged-p newestp)
- (assert (loop for term in terms never (find #\, term) ))
- (set-term-width)
- (ensure-config)
- (let ((response
- (api:request-with
- (:host (host))
- (api:get--oneliners :tags (str:join "," terms)
- :limit limit
- :notflagged (if not-flagged-p "true" "false")
- :newest (if newestp "true" "false")
- :onlyflagged (if all-flagged-p "true" "false")))))
- (cache-and-print-search-response response)))
-
-;;; RUNNING THINGS IN THE SHELL.
-
-(defun parent-process-name ()
- "Prints the name of the parent process of the current process."
- (let ((ppidfile (format nil "/proc/~a/status" (osicat-posix:getppid))))
- (first (last
- (ppcre:split "\\s"
- (with-open-file (input ppidfile)
- (read-line input)))))))
-
-(defmacro wait-until ((&key (timeout 1) (poll-every 0.01)) &body check)
- "Run CHECK every POLL-EVERY seconds until either TIMEOUT seconds
-have passed or CHECK returns non-nil."
- (let ((clockvar (gensym))
- (var (gensym)))
- `(loop
- for ,clockvar from 0 by ,poll-every to ,timeout
- for ,var = (progn ,@check)
- when ,var
- return ,var
- do (sleep ,poll-every)
- finally (return nil))))
-
-
-
-(defun run-with-shell
- (command
- &key
- (shell-name (parent-process-name))
- (await-output-p *ol-output-timeout*)
- (output-stream *standard-output*))
- "run COMMAND, a string, in a fresh shell environment, initialized
-with SHELL-NAME. The output from the command read line by line and is
-printed to OUTPUT-STREAM. "
- (let ((shell
- (uiop:launch-program shell-name :input :stream :output :stream)))
- (symbol-macrolet ((shell-input (uiop:process-info-input shell))
- (shell-output (uiop:process-info-output shell)))
- (write-line command shell-input)
- (finish-output shell-input)
- (if (and await-output-p
- (plusp await-output-p)
- (wait-until (:timeout await-output-p :poll-every 0.005)
- (listen shell-output)))
- (loop while (listen shell-output)
- do (princ (read-line shell-output) output-stream)
- (terpri output-stream)
- (sleep 0.005))))))
-
-
-
-