[elpa] externals/srht 6f87acb901 16/27: Add commands to create, update and delete git repo.

[ELPA Syncer]

branch: externals/srht
commit 6f87acb901ee74ea48b6b5c824ad8bd7f5c34359
Author: Aleksandr Vityazev <avityazev@posteo.org>
Commit: Aleksandr Vityazev <avityazev@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")