path: root/lib/client.lisp

;;;; main.lisp -- client actions

;; 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/>.
(in-package :oneliners.cli)

;;; 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))))

(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))))


;;; 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))))


;;; 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)))))

(defun bind-vars-and-run-oneliner (ol args &optional force-clip)
  (let* ((oneliner (oneliner-oneliner ol))
         (runstyle (oneliner-runstyle ol))
         (pos-args (collect-positional-arguments oneliner))
         (named-args (collect-named-arguments oneliner)))
    (when  (or (not (oneliner-isflagged ol))
               (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 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 (config-shell *config*) "bash")))))


;; (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.