init: Initial commit of org-clubhouse
As committed, this allows creating Clubhouse tickets from a heading in org-mode, and then updating the status of those tickets when the Org status updates
This commit is contained in:
Griffin Smith
commit
57008170b3
1 changed files with 421 additions and 0 deletions
421
org-clubhouse.el
Normal file
421
org-clubhouse.el
Normal file
|
|
@ -0,0 +1,421 @@
|
|||
;;; org-clubhouse.el --- Simple, unopinionated integration between org-mode and Clubhouse
|
||||
|
||||
;;; Copyright (C) 2018 Off Market Data, Inc. DBA Urbint
|
||||
|
||||
;;; Commentary:
|
||||
;;; org-clubhouse provides simple, unopinionated integration between Emacs's
|
||||
;;; org-mode and the Clubhouse issue tracker
|
||||
;;;
|
||||
;;; To configure org-clubhouse, create an authorization token in Cluhbouse's
|
||||
;;; settings, then place the following configuration somewhere private:
|
||||
;;;
|
||||
;;; (setq org-clubhouse-auth-token "<auth_token>"
|
||||
;;; org-clubhouse-team-name "<team-name>")
|
||||
;;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dash)
|
||||
(require 'dash-functional)
|
||||
(require 's)
|
||||
(require 'org)
|
||||
(require 'org-element)
|
||||
(require 'subr-x)
|
||||
(require 'json)
|
||||
|
||||
;;;
|
||||
;;; Configuration
|
||||
;;;
|
||||
|
||||
(defvar org-clubhouse-auth-token nil
|
||||
"Authorization token for the Clubhouse API")
|
||||
|
||||
(defvar org-clubhouse-team-name nil
|
||||
"Team name to use in links to Clubhouse
|
||||
ie https://app.clubhouse.io/<TEAM_NAME>/stories")
|
||||
|
||||
(defvar org-clubhouse-project-ids nil
|
||||
"Specific list of project IDs to synchronize with clubhouse.
|
||||
If unset all projects will be synchronized")
|
||||
|
||||
(defvar org-clubhouse-workflow-name "Default")
|
||||
|
||||
(defvar org-clubhouse-state-alist
|
||||
'(("LATER" . "Unscheduled")
|
||||
("[ ]" . "Ready for Development")
|
||||
("TODO" . "Ready for Development")
|
||||
("OPEN" . "Ready for Development")
|
||||
("ACTIVE" . "In Development")
|
||||
("PR" . "Review")
|
||||
("DONE" . "Merged")
|
||||
("[X]" . "Merged")
|
||||
("CLOSED" . "Merged")))
|
||||
|
||||
;;;
|
||||
;;; Utilities
|
||||
;;;
|
||||
|
||||
(defmacro comment (&rest _)
|
||||
"Comment out one or more s-expressions."
|
||||
nil)
|
||||
|
||||
(defun ->list (vec) (append vec nil))
|
||||
|
||||
(defun reject-archived (item-list)
|
||||
(-filter (lambda (item) (equal :json-false (alist-get 'archived item))) item-list))
|
||||
|
||||
(defun alist->plist (key-map alist)
|
||||
(->> key-map
|
||||
(-map (lambda (key-pair)
|
||||
(let ((alist-key (car key-pair))
|
||||
(plist-key (cdr key-pair)))
|
||||
(list plist-key (alist-get alist-key alist)))))
|
||||
(-flatten-n 1)))
|
||||
|
||||
(defun alist-get-equal (key alist)
|
||||
"Like `alist-get', but uses `equal' instead of `eq' for comparing keys"
|
||||
(->> alist
|
||||
(-find (lambda (pair) (equal key (car pair))))
|
||||
(cdr)))
|
||||
|
||||
(comment
|
||||
|
||||
(alist->plist
|
||||
'((foo . :foo)
|
||||
(bar . :something))
|
||||
|
||||
'((foo . "foo") (bar . "bar") (ignored . "ignoreme!")))
|
||||
;; => (:foo "foo" :something "bar")
|
||||
|
||||
)
|
||||
|
||||
;;;
|
||||
;;; Org-element interaction
|
||||
;;;
|
||||
|
||||
;; (defun org-element-find-headline ()
|
||||
;; (let ((current-elt (org-element-at-point)))
|
||||
;; (if (equal 'headline (car current-elt))
|
||||
;; current-elt
|
||||
;; (let* ((elt-attrs (cadr current-elt))
|
||||
;; (parent (plist-get elt-attrs :post-affiliated)))
|
||||
;; (goto-char parent)
|
||||
;; (org-element-find-headline)))))
|
||||
|
||||
(defun org-element-find-headline ()
|
||||
(let ((current-elt (org-element-at-point)))
|
||||
(when (equal 'headline (car current-elt))
|
||||
(cadr current-elt))))
|
||||
|
||||
(defun org-element-extract-clubhouse-id (elt)
|
||||
(when-let ((clubhouse-id-link (plist-get elt :CLUBHOUSE-ID)))
|
||||
(cond
|
||||
((string-match
|
||||
(rx "[[" (one-or-more anything) "]"
|
||||
"[" (group (one-or-more digit)) "]]")
|
||||
clubhouse-id-link)
|
||||
(string-to-int (match-string 1 clubhouse-id-link)))
|
||||
((string-match-p
|
||||
(rx buffer-start
|
||||
(one-or-more digit)
|
||||
buffer-end)
|
||||
clubhouse-id-link)
|
||||
(string-to-int clubhouse-id-link)))))
|
||||
|
||||
(comment
|
||||
(let ((strn "[[https://app.clubhouse.io/example/story/2330][2330]]"))
|
||||
(string-match
|
||||
(rx "[[" (one-or-more anything) "]"
|
||||
"[" (group (one-or-more digit)) "]]")
|
||||
strn)
|
||||
(string-to-int (match-string 1 strn)))
|
||||
|
||||
)
|
||||
|
||||
(defun org-element-clubhouse-id ()
|
||||
(org-element-extract-clubhouse-id
|
||||
(org-element-find-headline)))
|
||||
|
||||
;;;
|
||||
;;; API integration
|
||||
;;;
|
||||
|
||||
(defvar org-clubhouse-base-url* "https://api.clubhouse.io/api/v2")
|
||||
|
||||
(defun org-clubhouse-auth-url (url)
|
||||
(concat url
|
||||
"?"
|
||||
(url-build-query-string
|
||||
`(("token" ,org-clubhouse-auth-token)))))
|
||||
|
||||
(defun org-clubhouse-baseify-url (url)
|
||||
(if (s-starts-with? org-clubhouse-base-url* url) url
|
||||
(concat org-clubhouse-base-url*
|
||||
(if (s-starts-with? "/" url) url
|
||||
(concat "/" url)))))
|
||||
|
||||
(defun org-clubhouse-request (method url &optional data)
|
||||
(message "%s %s %s" method url (prin1-to-string data))
|
||||
(let* ((url-request-method method)
|
||||
(url-request-extra-headers
|
||||
'(("Content-Type" . "application/json")))
|
||||
(url-request-data data)
|
||||
(buf))
|
||||
|
||||
(setq url (-> url
|
||||
org-clubhouse-baseify-url
|
||||
org-clubhouse-auth-url))
|
||||
|
||||
(setq buf (url-retrieve-synchronously url))
|
||||
|
||||
(with-current-buffer buf
|
||||
(goto-char url-http-end-of-headers)
|
||||
(prog1 (json-read) (kill-buffer)))))
|
||||
|
||||
(cl-defun to-id-name-pairs
|
||||
(seq &optional (id-attr 'id) (name-attr 'name))
|
||||
(->> seq
|
||||
->list
|
||||
(-map (lambda (resource)
|
||||
(cons (alist-get id-attr resource)
|
||||
(alist-get name-attr resource))))))
|
||||
|
||||
(cl-defun org-clubhouse-fetch-as-id-name-pairs
|
||||
(resource &optional
|
||||
(id-attr 'id)
|
||||
(name-attr 'name))
|
||||
"Returns the given resource from clubhouse as (id . name) pairs"
|
||||
(let ((resp-json (org-clubhouse-request "GET" resource)))
|
||||
(-> resp-json
|
||||
->list
|
||||
reject-archived
|
||||
(to-id-name-pairs id-attr name-attr))))
|
||||
|
||||
(defun org-clubhouse-link-to-story (story-id)
|
||||
(format "https://app.clubhouse.io/%s/story/%d"
|
||||
org-clubhouse-team-name
|
||||
story-id))
|
||||
|
||||
(defun org-clubhouse-link-to-epic (epic-id)
|
||||
(format "https://app.clubhouse.io/%s/epic/%d"
|
||||
org-clubhouse-team-name
|
||||
epic-id))
|
||||
|
||||
(defun org-clubhouse-link-to-project (project-id)
|
||||
(format "https://app.clubhouse.io/%s/project/%d"
|
||||
org-clubhouse-team-name
|
||||
project-id))
|
||||
|
||||
;;;
|
||||
;;; Caching
|
||||
;;;
|
||||
|
||||
(comment
|
||||
(defcache org-clubhouse-projects
|
||||
(org-sync-clubhouse-fetch-as-id-name-pairs "projectx"))
|
||||
|
||||
(clear-org-clubhouse-projects-cache)
|
||||
(clear-org-clubhouse-cache)
|
||||
)
|
||||
|
||||
(defvar org-clubhouse-cache-clear-functions ())
|
||||
|
||||
(defmacro defcache (name &optional docstring &rest body)
|
||||
(let* ((doc (when docstring (list docstring)))
|
||||
(cache-var-name (intern (concat (symbol-name name)
|
||||
"-cache")))
|
||||
(clear-cache-function-name
|
||||
(intern (concat "clear-" (symbol-name cache-var-name)))))
|
||||
`(progn
|
||||
(defvar ,cache-var-name :no-cache)
|
||||
(defun ,name ()
|
||||
,@doc
|
||||
(when (equal :no-cache ,cache-var-name)
|
||||
(setq ,cache-var-name (progn ,@body)))
|
||||
,cache-var-name)
|
||||
(defun ,clear-cache-function-name ()
|
||||
(interactive)
|
||||
(setq ,cache-var-name :no-cache))
|
||||
|
||||
(push (quote ,clear-cache-function-name)
|
||||
org-clubhouse-cache-clear-functions))))
|
||||
|
||||
(defun org-clubhouse-clear-cache ()
|
||||
(interactive)
|
||||
(-map #'funcall org-clubhouse-cache-clear-functions))
|
||||
|
||||
;;;
|
||||
;;; API resource functions
|
||||
;;;
|
||||
|
||||
(defcache org-clubhouse-projects
|
||||
"Returns projects as (project-id . name)"
|
||||
(org-clubhouse-fetch-as-id-name-pairs "projects"))
|
||||
|
||||
(defcache org-clubhouse-epics
|
||||
"Returns projects as (project-id . name)"
|
||||
(org-clubhouse-fetch-as-id-name-pairs "epics"))
|
||||
|
||||
(defcache org-clubhouse-workflow-states
|
||||
"Returns worflow states as (name . id) pairs"
|
||||
(let* ((resp-json (org-clubhouse-request "GET" "workflows"))
|
||||
(workflows (->list resp-json))
|
||||
;; just assume it exists, for now
|
||||
(workflow (-find (lambda (workflow)
|
||||
(equal org-clubhouse-workflow-name
|
||||
(alist-get 'name workflow)))
|
||||
workflows))
|
||||
(states (->list (alist-get 'states workflow))))
|
||||
(to-id-name-pairs states
|
||||
'name
|
||||
'id)))
|
||||
|
||||
(defun org-clubhouse-stories-in-project (project-id)
|
||||
"Returns the stories in the given project as org bugs"
|
||||
(let ((resp-json (org-clubhouse-request "GET" (format "/projects/%d/stories" project-id))))
|
||||
(->> resp-json ->list reject-archived
|
||||
(-reject (lambda (story) (equal :json-true (alist-get 'completed story))))
|
||||
(-map (lambda (story)
|
||||
(cons
|
||||
(cons 'status
|
||||
(cond
|
||||
((equal :json-true (alist-get 'started story))
|
||||
'started)
|
||||
((equal :json-true (alist-get 'completed story))
|
||||
'completed)
|
||||
('t
|
||||
'open)))
|
||||
story)))
|
||||
(-map (-partial #'alist->plist
|
||||
'((name . :title)
|
||||
(id . :id)
|
||||
(status . :status)))))))
|
||||
|
||||
;;;
|
||||
;;; Story creation
|
||||
;;;
|
||||
|
||||
(cl-defun org-clubhouse-create-story-internal
|
||||
(title &key project-id epic-id)
|
||||
(assert (and (stringp title)
|
||||
(integerp project-id)
|
||||
(or (null epic-id) (integerp epic-id))))
|
||||
(org-clubhouse-request
|
||||
"POST"
|
||||
"stories"
|
||||
(json-encode
|
||||
`((name . ,title)
|
||||
(project_id . ,project-id)
|
||||
(epic_id . ,epic-id)))))
|
||||
|
||||
(defun org-clubhouse-prompt-for-project (cb)
|
||||
(ivy-read
|
||||
"Select a project: "
|
||||
(-map #'cdr (org-clubhouse-projects))
|
||||
:require-match t
|
||||
:history 'org-clubhouse-project-history
|
||||
:action (lambda (selected)
|
||||
(let ((project-id
|
||||
(->> (org-clubhouse-projects)
|
||||
(-find (lambda (proj)
|
||||
(string-equal (cdr proj) selected)))
|
||||
car)))
|
||||
(message "%d" project-id)
|
||||
(funcall cb project-id)))))
|
||||
|
||||
(defun org-clubhouse-prompt-for-epic (cb)
|
||||
(ivy-read
|
||||
"Select an epic: "
|
||||
(-map #'cdr (org-clubhouse-epics))
|
||||
:history 'org-clubhouse-epic-history
|
||||
:action (lambda (selected)
|
||||
(let ((epic-id
|
||||
(->> (org-clubhouse-epics)
|
||||
(-find (lambda (proj)
|
||||
(string-equal (cdr proj) selected)))
|
||||
car)))
|
||||
(message "%d" epic-id)
|
||||
(funcall cb epic-id)))))
|
||||
|
||||
(defun org-clubhouse-populate-created-story (story)
|
||||
(let ((elt (org-element-find-headline))
|
||||
(story-id (alist-get 'id story))
|
||||
(epic-id (alist-get 'epic_id story))
|
||||
(project-id (alist-get 'project_id story)))
|
||||
|
||||
(org-set-property "clubhouse-id"
|
||||
(org-make-link-string
|
||||
(org-clubhouse-link-to-story story-id)
|
||||
(number-to-string story-id)))
|
||||
|
||||
(org-set-property "clubhouse-epic"
|
||||
(org-make-link-string
|
||||
(org-clubhouse-link-to-epic epic-id)
|
||||
(alist-get epic-id (org-clubhouse-epics))))
|
||||
|
||||
(org-set-property "clubhouse-project"
|
||||
(org-make-link-string
|
||||
(org-clubhouse-link-to-project project-id)
|
||||
(alist-get project-id (org-clubhouse-projects))))
|
||||
|
||||
(org-todo "TODO")))
|
||||
|
||||
(defun org-clubhouse-create-story ()
|
||||
(interactive)
|
||||
;; (message (org-element-find-headline))
|
||||
(when-let ((elt (org-element-find-headline))
|
||||
(title (plist-get elt :title)))
|
||||
(if (plist-get elt :CLUBHOUSE-ID)
|
||||
(message "This headline is already a clubhouse story!")
|
||||
(org-clubhouse-prompt-for-project
|
||||
(lambda (project-id)
|
||||
(when project-id
|
||||
(org-clubhouse-prompt-for-epic
|
||||
(lambda (epic-id)
|
||||
(let* ((story (org-clubhouse-create-story-internal
|
||||
title
|
||||
:project-id project-id
|
||||
:epic-id epic-id)))
|
||||
(org-clubhouse-populate-created-story story))))))))))
|
||||
|
||||
;;;
|
||||
;;; Story updates
|
||||
;;;
|
||||
|
||||
(cl-defun org-clubhouse-update-story-internal
|
||||
(story-id &rest attrs)
|
||||
(assert (and (integerp story-id)
|
||||
(listp attrs)))
|
||||
(org-clubhouse-request
|
||||
"PUT"
|
||||
(format "stories/%d" story-id)
|
||||
(json-encode attrs)))
|
||||
|
||||
(defun org-clubhouse-update-status ()
|
||||
(when-let (clubhouse-id (org-element-clubhouse-id))
|
||||
(let* ((elt (org-element-find-headline))
|
||||
(todo-keyword (-> elt (plist-get :todo-keyword) (substring-no-properties))))
|
||||
(message todo-keyword)
|
||||
(when-let ((clubhouse-workflow-state
|
||||
(alist-get-equal todo-keyword org-clubhouse-state-alist))
|
||||
(workflow-state-id
|
||||
(alist-get-equal clubhouse-workflow-state (org-clubhouse-workflow-states))))
|
||||
(org-clubhouse-update-story-internal
|
||||
clubhouse-id
|
||||
:workflow_state_id workflow-state-id)
|
||||
(message "Successfully updated clubhouse status to \"%s\""
|
||||
clubhouse-workflow-state)))))
|
||||
|
||||
(define-minor-mode org-clubhouse-mode
|
||||
:init-value nil
|
||||
:group 'org
|
||||
:lighter "Org-Clubhouse"
|
||||
:keymap '()
|
||||
(add-hook 'org-after-todo-state-change-hook
|
||||
'org-clubhouse-update-status
|
||||
nil
|
||||
t))
|
||||
|
||||
|
||||
(provide 'org-clubhouse)
|
||||
;;; org-clubhouse.el ends here
|
||||
Loading…
Reference in a new issue