branch: externals/srht
commit 6f87acb901ee74ea48b6b5c824ad8bd7f5c34359
Author: Aleksandr Vityazev <avitya...@posteo.org>
Commit: Aleksandr Vityazev <avitya...@posteo.org>
Add commands to create, update and delete git repo.
* lisp/srht-git: Add interactive commands, fix issues.
* lisp/srht-paste: Move srht-paste-file-name-concat,
srht-paste--kill-link ...
* lisp/srht: ... here. srht-read-with-annotaion,
srht-with-json-read-from-string: New function.
---
lisp/srht-git.el | 124 +++++++++++++++++++++++++++++++++++++++++++++++------
lisp/srht-paste.el | 46 +++-----------------
lisp/srht.el | 45 +++++++++++++++++++
tests/test.el | 9 ++++
4 files changed, 172 insertions(+), 52 deletions(-)
diff --git a/lisp/srht-git.el b/lisp/srht-git.el
index 93174bdd8d..905e3fe375 100644
--- a/lisp/srht-git.el
+++ b/lisp/srht-git.el
@@ -25,6 +25,9 @@
(require 'srht)
+(defvar srht-git-repos nil
+ "Authenticated user repos.")
+
(defun srht-git--make-crud (path &optional body form)
"Make crud for git service.
PATH is the path for the URI. BODY is the body sent to the URI.
@@ -40,9 +43,6 @@ If USERNAME is nil, the authenticated user is assumed."
"/api/user")))
(srht-git--make-crud path)))
-;; (srht-retrive (srht-git-user "~akagi"))
-;; (srht-retrive (srht-git-user "~sircmpwn"))
-
(defun srht-git-repos (&optional username)
"Retrive list of repository resources owned by this USERNAME.
If USERNAME is nil the authenticated user is assumed."
@@ -51,23 +51,17 @@ If USERNAME is nil the authenticated user is assumed."
"/api/repos")))
(srht-git--make-crud path)))
-;; (setq akagi-repos-test (srht-retrive (srht-git-repos)))
-
-(cl-defun srht-git-make (&key (visibility "unlisted") description name)
+(cl-defun srht-git-make (&key visibility description name)
"Make paste parameters.
VISIBILITY must be one of \"public\", \"private\", or \"unlisted\".
DESCRIPTION is repository description, markdown is allowed.
NAME is repository name."
- (cl-assert (or (member visibility '("unlisted" "public" "private"))
- (not (null name))))
+ (cl-assert (and (member visibility '("unlisted" "public" "private"))
+ (not (null name))))
`((name . ,name)
(description . ,description)
(visibility . ,visibility)))
-;; (srht-git-make :visibility "ulnlisted" :name "test-repo" :description "hi")
-;; (srht-git-make :visibility "ulnlisted" :description "hi")
-;; (json-encode (srht-git-make :visibility "unlisted" :name "test-repo"
:description "hi"))
-
(defun srht-git-repo (repo-name &optional username &rest details)
"Create, retrieve, delete or update a git repository.
@@ -76,7 +70,7 @@ the name of an existing repository.
When retrieving if USERNAME is nil the authenticated user is assumed.
-When updating DETAILS, you must specify DETAILS (see `srht-git-make').
+When updating, you must specify DETAILS (see `srht-git-make').
;; NOTE: Updating the name will create a redirect.
When creating repository omit REPO-NAME and specify DETAILS
@@ -84,6 +78,9 @@ When creating repository omit REPO-NAME and specify DETAILS
(cond
((and (stringp repo-name) (stringp username))
(srht-git--make-crud (format "/api/%s/repos/%s" username repo-name)))
+ ((and (stringp repo-name) details)
+ (srht-git--make-crud (format "/api/repos/%s" repo-name)
+ (apply #'srht-git-make details)))
((stringp repo-name) (srht-git--make-crud (format "/api/repos/%s"
repo-name)))
(t (srht-git--make-crud "/api/repos" (apply #'srht-git-make details)))))
@@ -161,5 +158,106 @@ NAME is a repository name. If USERNAME is nil the
authenticated user
is assumed."
(srht-git--endpoints "tree" name username))
+(defun srht-git--candidates ()
+ "Return completion candidates."
+ (seq-map (pcase-lambda ((map (:created c)
+ (:visibility v)
+ (:name n)))
+ (list n c v n))
+ (plist-get (or srht-git-repos
+ (setq srht-git-repos
+ (srht-retrive (srht-git-repos))))
+ :results)))
+
+(defun srht-git--annot (str)
+ "Function to add annotations in the completions buffer for STR."
+ (pcase-let* (((seq _n c v) (assoc str (srht-git--candidates)))
+ (l (- 40 (length (substring-no-properties str))))
+ (bb (make-string l (string-to-char " ")))
+ (sb (cond
+ ((string= v "public") " ")
+ ((string= v "private") " ")
+ ((string= v "unlisted") " "))))
+ (concat bb (format "%s%s%s" v sb c))))
+
+(defun srht-git--repo-name-read ()
+ ""
+ (srht-read-with-annotaion "Select repository: "
+ (srht-git--candidates) #'srht-git--annot))
+
+(defvar srht-git-repo-name-history nil
+ "History variable.")
+
+(defun srht-git--else (plz-error)
+ "An optional callback function.
+Called when the request fails with one argument, a ‘plz-error’ struct
PLZ-ERROR."
+ (pcase-let* (((cl-struct plz-error response) plz-error)
+ ((cl-struct plz-response status body) response))
+ (pcase status
+ (201 (srht-with-json-read-from-string body
+ (map (:name repo-name)
+ (:owner (map (:canonical_name username))))
+ (srht-kill-link 'git username repo-name)
+ (srht-retrive (srht-git-repos)
+ :then (lambda (resp)
+ (setq srht-git-repos resp)))))
+ (204 (srht-retrive (srht-git-repos)
+ :then (lambda (resp)
+ (setq srht-git-repos resp)
+ (message "Deleted!"))))
+ (_ (error "Unkown error with status %s: %S" status plz-error)))))
+
+;;;###autoload
+(defun srht-git-repo-create (visibility name description)
+ "Create repository NAME with selected VISIBILITY and DESCRIPTION."
+ (interactive
+ (list (completing-read "Visibility: "
+ '("private" "public" "unlisted") nil t)
+ (read-string "New git repository name: " nil
+ 'srht-git-repo-name-history)
+ (read-string "Repository description (markdown): ")))
+ (srht-create (srht-git-repo nil nil
+ :visibility visibility
+ :name name
+ :description description)
+ :else #'srht-git--else))
+
+;;;###autoload
+(defun srht-git-repo-update (repo-name visibility name description)
+ "Update repository REPO-NAME.
+Set VISIBILITY, NAME and DESCRIPTION."
+ (interactive
+ (list (srht-git--repo-name-read)
+ (completing-read "Visibility: "
+ '("private" "public" "unlisted") nil t)
+ (read-string "Repository name: " nil
+ 'srht-git-repo-name-history)
+ (read-string "Repository description (markdown): ")))
+ (when (yes-or-no-p (format "Update %s repository?" repo-name))
+ (srht-update (srht-git-repo repo-name nil
+ :visibility visibility
+ :name name
+ :description description)
+ :then (lambda (_resp)
+ ;; NOTE: resp examle
+ ;; (:id 110277
+ ;; :created 2022-04-29T14:05:29.662497Z
+ ;; :updated 2022-04-29T14:43:53.155504Z
+ ;; :name test-from-srht-6.el
+ ;; :owner (:canonical_name ~akagi :name akagi)
+ ;; :description nil
+ ;; :visibility unlisted)
+ (srht-retrive (srht-git-repos)
+ :then (lambda (resp)
+ (setq srht-git-repos resp)))))))
+
+;;;###autoload
+(defun srht-git-repo-delete (name)
+ "Delete NAME repository."
+ (interactive (list (srht-git--repo-name-read)))
+ (when (yes-or-no-p
+ (format "This action cannot be undone.\n Delete %s repository?" name))
+ (srht-delete (srht-git-repo name) :else #'srht-git--else)))
+
(provide 'srht-git)
;;; srht-git.el ends here
diff --git a/lisp/srht-paste.el b/lisp/srht-paste.el
index 55c01d43ec..b3ef3f7354 100644
--- a/lisp/srht-paste.el
+++ b/lisp/srht-paste.el
@@ -71,16 +71,8 @@ CONTENTS must be a UTF-8 encoded string; binary files are
not allowed."
(defun srht-paste--sha ()
"Read a FILENAME in the minibuffer, with completion and return SHA."
- (let* ((p (srht-paste--candidates))
- (table
- (lambda (string pred action)
- (if (eq action 'metadata)
- `(metadata
- (annotation-function . srht-paste--annot)
- (cycle-sort-function . identity)
- (display-sort-function . identity))
- (complete-with-action action p string pred)))))
- (car (last (assoc (completing-read "Select paste: " table) p)))))
+ (srht-read-with-annotaion "Select paste: "
+ (srht-paste--candidates) #'srht-paste--annot))
(defun srht-paste (&optional sha &rest details)
"Create, retrieve or delete a paste.
@@ -104,40 +96,16 @@ the whole buffer."
(buffer-substring-no-properties (region-beginning) (region-end))
(buffer-string)))
-(defalias 'srht-paste-file-name-concat
- (if (fboundp 'file-name-concat)
- #'file-name-concat
- (lambda (directory &rest components)
- (let ((components (cl-remove-if (lambda (el)
- (or (null el) (equal "" el)))
- components))
- file-name-handler-alist)
- (if (null components)
- directory
- (apply #'srht-paste-file-name-concat
- (concat (unless (or (equal "" directory) (null directory))
- (file-name-as-directory directory))
- (car components))
- (cdr components)))))))
-
-(defun srht-paste--kill-link (name sha)
- "Make URL constructed from NAME and SHA the latest kill in the kill ring."
- (kill-new (srht-paste-file-name-concat (srht--make-uri 'paste nil nil) name
sha))
- (message "Paste URL in kill-ring"))
-
(defun srht-paste--else (plz-error)
"An optional callback function.
Called when the request fails with one argument, a ‘plz-error’ struct
PLZ-ERROR."
(pcase-let* (((cl-struct plz-error response) plz-error)
((cl-struct plz-response status body) response))
(pcase status
- (201 (pcase-let* ((json-object-type 'plist)
- (json-key-type 'keyword)
- (json-array-type 'list)
- ((map (:sha sha)
- (:user (map (:canonical_name name))))
- (json-read-from-string body)))
- (srht-paste--kill-link name sha)
+ (201 (srht-with-json-read-from-string body
+ (map (:sha sha)
+ (:user (map (:canonical_name name))))
+ (srht-kill-link 'paste name sha)
(srht-retrive (srht-pastes)
:then (lambda (resp)
(setq srht-paste-all-pastes resp)))))
@@ -175,7 +143,7 @@ Called when the request fails with one argument, a
‘plz-error’ struct PLZ-ER
(defun srht-paste-link (user)
"Kill the link of the selected paste owned by the USER."
(interactive (list (read-string "User: ")))
- (srht-paste--kill-link user (srht-paste--sha)))
+ (srht-kill-link 'paste user (srht-paste--sha)))
(provide 'srht-paste)
;;; srht-paste.el ends here
diff --git a/lisp/srht.el b/lisp/srht.el
index 7a13ecee43..775bcb02a6 100644
--- a/lisp/srht.el
+++ b/lisp/srht.el
@@ -160,5 +160,50 @@ contain the body at all. FORM is optional."
"Create an API request with ARGS using the DELETE method."
(srht--make-crud-request 'delete args))
+(defun srht-read-with-annotaion (prompt candidates annot-function)
+ "TODO: doc"
+ (declare (indent 1))
+ (let* ((p candidates)
+ (table
+ (lambda (string pred action)
+ (if (eq action 'metadata)
+ `(metadata
+ (annotation-function . ,annot-function)
+ (cycle-sort-function . identity)
+ (display-sort-function . identity))
+ (complete-with-action action p string pred)))))
+ (car (last (assoc (completing-read prompt table) p)))))
+
+(defalias 'srht-file-name-concat
+ (if (fboundp 'file-name-concat)
+ #'file-name-concat
+ (lambda (directory &rest components)
+ (let ((components (cl-remove-if (lambda (el)
+ (or (null el) (equal "" el)))
+ components))
+ file-name-handler-alist)
+ (if (null components)
+ directory
+ (apply #'srht-file-name-concat
+ (concat (unless (or (equal "" directory) (null directory))
+ (file-name-as-directory directory))
+ (car components))
+ (cdr components)))))))
+
+(defun srht-kill-link (service name resource)
+ "TODO: update.
+Make URL constructed from NAME and SHA the latest kill in the kill ring."
+ (kill-new (srht-file-name-concat (srht--make-uri service nil nil) name
resource))
+ (message "URL in kill-ring"))
+
+(defmacro srht-with-json-read-from-string (string matching-pattern &rest body)
+ "TODO: doc."
+ (declare (indent 1))
+ `(pcase-let* ((json-object-type 'plist)
+ (json-key-type 'keyword)
+ (json-array-type 'list)
+ (,matching-pattern (json-read-from-string ,string)))
+ ,@body))
+
(provide 'srht)
;;; srht.el ends here
diff --git a/tests/test.el b/tests/test.el
index c786375019..a5d431449b 100644
--- a/tests/test.el
+++ b/tests/test.el
@@ -39,6 +39,15 @@
(pcase-let (((map (:path name)) (srht-git-repo "srht.el")))
(should (equal "/api/repos/srht.el" name))))
+;; (srht-retrive (srht-git-user "~akagi"))
+;; (srht-retrive (srht-git-user "~sircmpwn"))
+
+;; (setq akagi-repos-test (srht-retrive (srht-git-repos)))
+
+;; (srht-git-make :visibility "ulnlisted" :name "test-repo" :description "hi")
+;; (srht-git-make :visibility "ulnlisted" :description "hi")
+;; (json-encode (srht-git-make :visibility "unlisted" :name "test-repo"
:description "hi"))
+
;; (srht-retrive (srht-git-repo "srht.el"))
;; (srht-retrive (srht-git-repo "rrr" "~akagi"))
;; (srht-git-repo nil "~akagi" :visibility "ulnlisted" :name "test-repo"
:description "hi")
