;;; sponsor-debian.el --- Make it easy to sponsor packages on Debian.
;;;
;;; Commentary:
;;;
;;; This is a simple package whose purpose is to:
;;;
;;; - "gbp clone" the sponsoree repository;
;;; - Create a project under a team's namespace if needed/wanted;
;;;
;;; Code:

(require 'magit)
(require 'plz)

(defgroup sdj/sponsor-debian-pkg ()
  "Helper to sponsor Debian packages.")

(defcustom sdj/sponsor-debian-pkg-path
  nil
  "Path where sponsored packages will be stored."
  :group 'sdj/sponsor-debian-pkg
  :type 'directory)

(defcustom sdj/sponsor-debian-pkg-salsa-api-url
  "https://salsa.debian.org/api/v4/"
  "The API URL for salsa.debian.org."
  :group 'sdj/sponsor-debian-pkg
  :type 'string)

(defcustom sdj/sponsor-debian-pkg-salsa-api-token
  nil
  "The API token for salsa.debian.org."
  :group 'sdj/sponsor-debian-pkg
  :type 'string)

(defun sdj/sponsor--generate-sponsoree-candidates-from-dir ()
  "Generate a list of sponsoree candidates from the contents of 'sdj/sponsor-debian-pkg-path'.

The idea is that each directory name inside that path corresponds
to a salsa.d.o username."
  (flatten-tree
   (mapcar
    (lambda (e)
      (let ((dirname (car e)))
	(when (and (nth 2 e)
		   ; Exclude "." and ".." from the list
		   (not (seq-contains-p '("." "..") dirname)))
	  dirname)))
    (directory-files-and-attributes sdj/sponsor-debian-pkg-path))))

(defun sdj/sponsor--generate-sponsoree-candidates ()
  "Generate a list of sponsoree candidates from salsa.d.o.

The idea is to query Debian Brasilia's 'docs' project, obtain a
list of the last 100 issues, and gather all the usernames that
ever commented on those issues.

Return an alist of (user . username)."
  (let* ((debian-bsb-users (plz 'get
			     (concat sdj/sponsor-debian-pkg-salsa-api-url
				     "projects/"
				     (url-hexify-string "debian-brasilia-team/docs")
				     "/issues?per_page=100&order_by=updated_at")
			     :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token))
			     :timeout 60
			     :connect-timeout 60
			     :as #'json-read)))
    (seq-uniq
     (cl-map 'list
	     (lambda (e)
	       (let* ((u (alist-get 'author e))
		      (name (alist-get 'name u))
		      (username (alist-get 'username u)))
		 (cons (format "%s (%s)" name username) username)))
	     debian-bsb-users))))

(defun sdj/sponsor--parse-teams ()
  "Parse a JSON representation of all teams which we are subscribed to.

Return an alist of (team . id)."
  (let ((parsedteams (json-read)))
    (delete
     nil
     (mapcar
      (lambda (e)
	(when (string= (alist-get 'kind e) "group")
	  (cons (alist-get 'full_path e) (alist-get 'id e))))
      parsedteams))))

(defun sdj/sponsor--api-endpoint (name)
  (concat sdj/sponsor-debian-pkg-salsa-api-url name "/"))

(defun sdj/sponsor--generate-team-candidates ()
  (plz 'get (sdj/sponsor--api-endpoint "namespaces")
    :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token))
    :as #'sdj/sponsor--parse-teams))

(defun sdj/sponsor--team-repo-exists-p (team repo)
  (condition-case err
      (let ((r (plz 'get
		 (concat (sdj/sponsor--api-endpoint "projects")
			 (url-hexify-string (concat team "/" repo)))
		 :as 'response)))
	(when (plz-response-p r)
	  (pcase (plz-response-status r)
	    (200 t)
	    (404 nil))))
    (plz-error nil)))

(defun sdj/sponsor--sanitize-import-url (url)
  (concat (string-replace "git@salsa.debian.org:"
			  "https://salsa.debian.org/"
			  url)
	  (unless (string-suffix-p ".git" url)
	    ".git")))

(defun sdj/sponsor--parse-new-repo-clone-url ()
  (let ((parsenewrepo (json-read)))
    (alist-get 'ssh_url_to_repo parsenewrepo)))

(defun sdj/sponsor--create-team-repo (team projname repourl)
  (plz 'post (sdj/sponsor--api-endpoint "projects")
    :headers `(("Content-Type" . "application/json")
	       ("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token))
    :body (json-encode
	   (delete nil
		   `(("name" . ,projname)
		     ("description" . ,(concat "Debian package for " projname))
		     ,(when repourl
			`("import_url" . ,(sdj/sponsor--sanitize-import-url repourl)))
		     ("namespace_id" . ,(cdr team))
		     ("initialize_with_readme" . false))))
    :as #'sdj/sponsor--parse-new-repo-clone-url))

(defun sdj/sponsor--make-team-repo-url (team projname)
  (concat "git@salsa.debian.org:"
	  (car team) "/"
	  projname ".git"))

(defun sdj/sponsor--get-or-create-team-repo (team projname repourl &optional dontask-p)
  (if (sdj/sponsor--team-repo-exists-p (car team) projname)
      (sdj/sponsor--make-team-repo-url team projname)
    (when (or dontask-p
	      (y-or-n-p "Would you like to create the repository under the team's namespace? "))
      (message "Creating the team repository (%s/%s.git)..."
	       (car team) projname)
      (sdj/sponsor--create-team-repo team projname repourl))))

(defun sdj/sponsor--confirm-username (user)
  (let ((u (plz 'get
	     (concat sdj/sponsor-debian-pkg-salsa-api-url "users?username=" (url-hexify-string user))
	     :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token))
	     :as #'json-read)))
    (and (not (seq-empty-p u)) user)))

(defun sdj/sponsor--confirm-team (team)
  (condition-case err
      (let ((u (plz 'get
		 (concat sdj/sponsor-debian-pkg-salsa-api-url "namespaces/" (url-hexify-string team))
		 :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token))
		 :as #'json-read)))
	(and (not (seq-empty-p u)) (cons team (alist-get 'id u))))
    (plz-error nil)))

(defun sdj/sponsor--read-sponsoree-choice ()
  (let* ((sponsoreealist (sdj/sponsor--generate-sponsoree-candidates))
	 (sponsoreechoice (completing-read "Sponsoree: " sponsoreealist)))
    (or (alist-get sponsoreechoice sponsoreealist nil nil #'string=)
	(sdj/sponsor--confirm-username sponsoreechoice))))

(defun sdj/sponsor--read-team-choice (&optional dontask-p)
  (when (or dontask-p
	    (y-or-n-p "Would you like to specify a team? "))
    (let* ((teamalist (sdj/sponsor--generate-team-candidates))
	   (teamchoice (completing-read "Team: " teamalist nil t)))
      (cons teamchoice
	    (alist-get teamchoice teamalist nil nil #'string=)))))

(defun sdj/sponsor--read-string-or-nil (prompt)
  (let ((r (read-from-minibuffer prompt)))
    (unless (string-empty-p r)
      r)))

(defun sdj/sponsor--read-repourl (&optional prompt)
  (let ((r (sdj/sponsor--read-string-or-nil (or prompt
						"Repository URL: "))))
    (when r
      (string-remove-suffix "/" r))))

(defun sdj/sponsor--get-namespace-from-repourl (repourl)
  (let ((str-no-url (or (and (string-prefix-p "git@salsa.debian.org:" repourl)
			     (string-remove-prefix "git@salsa.debian.org:" repourl))
			(and (string-prefix-p "https://salsa.debian.org/" repourl)
			     (string-remove-prefix "https://salsa.debian.org/" repourl)))))
    (string-remove-suffix
     "/"
     (string-remove-prefix
      "/"
      (file-name-directory
       (string-remove-suffix "/" str-no-url))))))

  ;; (replace-regexp-in-string
  ;;  (rx
  ;;   (or "git@salsa.debian.org:" "https://salsa.debian.org/")
  ;;   (group (one-or-more (not "/"))) (minimal-match (one-or-more not-newline)))
  ;; 			      "\\1" repourl nil nil nil ))

(defun sdj/sponsor--get-project-from-repourl (repourl)
  (file-name-base (string-remove-suffix "/" repourl)))

(defun sdj/sponsor--what-is-this-namespace (namespace)
  (let* ((username (sdj/sponsor--confirm-username namespace))
	 (team (and (not username)
		    (sdj/sponsor--confirm-team namespace))))
    (cond
     (username
      (cons 'username username))
     (team
      (cons 'team team))
     (t
      (error "Could not find namespace '%s'" namespace)))))

(defun sdj/sponsor-init--read-args ()
  (let* ((repo (sdj/sponsor--read-repourl))
	 (namespace (sdj/sponsor--get-namespace-from-repourl repo))
	 (result (sdj/sponsor--what-is-this-namespace namespace))
	 (team (or (and (eq (car result) 'team)
			(cdr result))
		   (sdj/sponsor--read-team-choice)))
	 (sponsoree (or (and (eq (car result) 'username)
			     (cdr result))
			(sdj/sponsor--read-sponsoree-choice))))
    (when (y-or-n-p (format "Sponsoree: [%s]; Team: [%s]; OK? " sponsoree (or (car team) "none")))
      (list sponsoree team repo))))

;;;###autoload
(defun sdj/sponsor-create-team-repo (team projname sponsoree-repourl)
  (interactive
   (list
    (sdj/sponsor--read-team-choice t)
    (sdj/sponsor--read-string-or-nil "Project name: ")
    (sdj/sponsor--read-repourl "Sponsoree repository to import into the new one (optional): ")))
  (when (or (not team) (not projname))
    (error "You must provide a valid team and a project name"))
  (let ((team-repourl (sdj/sponsor--get-or-create-team-repo team projname sponsoree-repourl t)))
    (when sponsoree-repourl
      (when-let* ((sponsoree (sdj/sponsor--get-namespace-from-repourl sponsoree-repourl))
		  (sponsoreedir (file-name-as-directory
				 (concat sdj/sponsor-debian-pkg-path sponsoree)))
		  (projdir (file-name-as-directory
			    (concat sponsoreedir projname)))
		  (team-gitdir (file-name-as-directory
				(concat projdir projname))))
	(when (and (not (file-directory-p team-gitdir))
		   (y-or-n-p
		    (format "Would you like to clone the team's repository inside %s's directory? " sponsoree)))
	  (mkdir projdir t)
	  (let ((default-directory projdir))
	    (message "Cloning the team repository...")
	    (call-process "gbp" nil (get-buffer-create "*gbp output*") nil
			  "clone" team-repourl team-gitdir))
	  (let ((default-directory team-gitdir))
	    (unless (magit-remote-p sponsoree)
	      (message "Adding %s as a remote of the team repository..." sponsoree)
	      (call-process "git" nil (get-buffer-create "*gbp output*") nil
			    "remote" "add" sponsoree sponsoree-repourl)
	      (message "Fetching all remotes inside the team repository...")
	      (call-process "git" nil (get-buffer-create "*gbp output*") nil
			    "fetch" sponsoree))))))))

;;;###autoload
(defun sdj/sponsor-init (sponsoree team repo)
  (interactive
   (sdj/sponsor-init--read-args))
  (when (or (not sponsoree) (not repo))
    (error "You must provide a valid sponsoree name and a repository URL"))
  (let* ((projname (sdj/sponsor--get-project-from-repourl repo))
	 (sponsoreedir (file-name-as-directory
			(concat sdj/sponsor-debian-pkg-path sponsoree)))
	 (projdir (file-name-as-directory
		   (concat sponsoreedir projname)))
	 (repo-is-private-p (string-search (concat "/" sponsoree "/") repo))
	 (sponsoree-gitdir (concat projdir projname
				   (when repo-is-private-p
				     (concat "-" sponsoree)))))
    (message "Creating directory %s..." projdir)
    (mkdir projdir t)
    (let ((default-directory projdir))
      (unless (file-directory-p sponsoree-gitdir)
	(message "Invoking gbp clone %s..." repo)
	(call-process "gbp" nil (get-buffer-create "*gbp output*") nil
		      "clone" repo sponsoree-gitdir))
      (when (and team repo-is-private-p)
	(when-let ((team-repourl (sdj/sponsor--get-or-create-team-repo team projname repo))
		   (team-gitdir (concat projdir projname)))
	  (unless (file-directory-p team-gitdir)
	    (message "Cloning the team repository...")
	    (call-process "gbp" nil (get-buffer-create "*gbp output*") nil
			  "clone" team-repourl))
	  (let ((default-directory team-gitdir))
	    (unless (magit-remote-p sponsoree)
	      (message "Adding %s as a remote of the team repository..." sponsoree)
	      (call-process "git" nil (get-buffer-create "*gbp output*") nil
			    "remote" "add" sponsoree repo)
	      (message "Fetching all remotes inside the team repository...")
	      (call-process "git" nil (get-buffer-create "*gbp output*") nil
			     "fetch" sponsoree))))))
    (dired sponsoree-gitdir)))

(provide 'sponsor-debian)

;;; sponsor-debian.el ends here