mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
tvl-depot/users/aspen/org-clubhouse/org-clubhouse.el
Aspen Smith 82ecd61f5c chore(users): grfn -> aspen 
Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9
Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809
Autosubmit: aspen <root@gws.fyi>
Reviewed-by: sterni <sternenseemann@systemli.org>
Tested-by: BuildkiteCI
Reviewed-by: lukegb <lukegb@tvl.fyi>
2024-02-14 19:37:41 +00:00

1241 lines
44 KiB
EmacsLisp
Raw Blame History

;;; org-clubhouse.el --- Simple, unopinionated integration between org-mode and
;;; Clubhouse
;;; Copyright (C) 2018 Off Market Data, Inc. DBA Urbint
;;; Permission is hereby granted, free of charge, to any person obtaining a copy
;;; of this software and associated documentation files (the "Software"), to
;;; deal in the Software without restriction, including without limitation the
;;; rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
;;; sell copies of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;; The above copyright notice and this permission notice shall be included in
;;; all copies or substantial portions of the Software.
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
;;; IN THE SOFTWARE.
;;; 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 'cl-macs)
(require 'dash)
(require 'dash-functional)
(require 's)
(require 'org)
(require 'org-element)
(require 'subr-x)
(require 'ivy)
(require 'json)
;;;
;;; Configuration
;;;
(defvar org-clubhouse-auth-token nil
"Authorization token for the Clubhouse API.")
(defvar org-clubhouse-username nil
"Username for the current Clubhouse user.
Unfortunately, the Clubhouse API doesn't seem to provide this via the API given
an API token, so we need to configure this for
`org-clubhouse-claim-story-on-status-updates' to work")
(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-default-story-type nil
"Sets the default story type. If set to 'nil', it will interactively prompt
the user each and every time a new story is created. If set to 'feature',
'bug', or 'chore', that value will be used as the default and the user will
not be prompted")
(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"))
"Alist mapping org-mode todo keywords to their corresponding states in
Clubhouse. In `org-clubhouse-mode', moving headlines to these todo keywords
will update to the corresponding status in Clubhouse")
(defvar org-clubhouse-story-types
'(("feature" . "Feature")
("bug" . "Bug")
("chore" . "Chore")))
(defvar org-clubhouse-default-story-types
'(("feature" . "Feature")
("bug" . "Bug")
("chore" . "Chore")
("prompt" . "**Prompt each time (do not set a default story type)**")))
(defvar org-clubhouse-default-state "Proposed"
"Default state to create all new stories in.")
(defvar org-clubhouse-claim-story-on-status-update 't
"Controls the assignee behavior of stories on status update.
If set to 't, will mark the current user as the owner of any clubhouse
stories on any update to the status.
If set to nil, will never automatically update the assignee of clubhouse
stories.
If set to a list of todo-state's, will mark the current user as the owner of
clubhouse stories whenever updating the status to one of those todo states.")
(defvar org-clubhouse-create-stories-with-labels nil
"Controls the way org-clubhouse creates stories with labels based on org tags.
If set to 't, will create labels for all org tags on headlines when stories are
created.
If set to 'existing, will set labels on created stories only if the label
already exists in clubhouse
If set to nil, will never create stories with labels")
;;;
;;; Utilities
;;;
(defmacro comment (&rest _)
"Comment out one or more s-expressions."
nil)
(defun ->list (vec) (append vec nil))
(defun reject-archived (item-list)
(-reject (lambda (item) (equal :json-true (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)))
(defun invert-alist (alist)
"Invert the keys and values of ALIST."
(-map (lambda (cell) (cons (cdr cell) (car cell))) alist))
(comment
(alist->plist
'((foo . :foo)
(bar . :something))
'((foo . "foo") (bar . "bar") (ignored . "ignoreme!")))
;; => (:foo "foo" :something "bar")
)
(defun find-match-in-alist (target alist)
(->> alist
(-find (lambda (key-value)
(string-equal (cdr key-value) target)))
car))
(defun org-clubhouse-collect-headlines (beg end)
"Collects the headline at point or the headlines in a region. Returns a list."
(if (and beg end)
(org-clubhouse-get-headlines-in-region beg end)
(list (org-element-find-headline))))
(defun org-clubhouse-get-headlines-in-region (beg end)
"Collects the headlines from BEG to END"
(save-excursion
;; This beg/end clean up pulled from `reverse-region`.
;; it expands the region to include the full lines from the selected region.
;; put beg at the start of a line and end and the end of one --
;; the largest possible region which fits this criteria
(goto-char beg)
(or (bolp) (forward-line 1))
(setq beg (point))
(goto-char end)
;; the test for bolp is for those times when end is on an empty line;
;; it is probably not the case that the line should be included in the
;; reversal; it isn't difficult to add it afterward.
(or (and (eolp) (not (bolp))) (progn (forward-line -1) (end-of-line)))
(setq end (point-marker))
;; move to the beginning
(goto-char beg)
;; walk by line until past end
(let ((headlines '())
(before-end 't))
(while before-end
(add-to-list 'headlines (org-element-find-headline))
(let ((before (point)))
(org-forward-heading-same-level 1)
(setq before-end (and (not (eq before (point))) (< (point) end)))))
(reverse headlines))))
;;;
;;; 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 ()
(save-mark-and-excursion
(when (not (outline-on-heading-p)) (org-back-to-heading))
(let ((current-elt (org-element-at-point)))
(when (equal 'headline (car current-elt))
(cadr current-elt)))))
(defun org-element-extract-clubhouse-id (elt &optional property)
(when-let* ((clubhouse-id-link (plist-get elt (or property :CLUBHOUSE-ID))))
(cond
((string-match
(rx "[[" (one-or-more anything) "]"
"[" (group (one-or-more digit)) "]]")
clubhouse-id-link)
(string-to-number (match-string 1 clubhouse-id-link)))
((string-match-p
(rx buffer-start
(one-or-more digit)
buffer-end)
clubhouse-id-link)
(string-to-number 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-number (match-string 1 strn)))
)
(defun org-element-clubhouse-id ()
(org-element-extract-clubhouse-id
(org-element-find-headline)))
(defun org-clubhouse-clocked-in-story-id ()
"Return the clubhouse story-id of the currently clocked-in org entry, if any."
(save-mark-and-excursion
(save-current-buffer
(when (org-clocking-p)
(set-buffer (marker-buffer org-clock-marker))
(save-restriction
(when (or (< org-clock-marker (point-min))
(> org-clock-marker (point-max)))
(widen))
(goto-char org-clock-marker)
(org-element-clubhouse-id))))))
(comment
(org-clubhouse-clocked-in-story-id)
)
(defun org-element-and-children-at-point ()
(let* ((elt (org-element-find-headline))
(contents-begin (or (plist-get elt :contents-begin)
(plist-get elt :begin)))
(end (plist-get elt :end))
(level (plist-get elt :level))
(children '()))
(save-excursion
(goto-char (+ contents-begin (length (plist-get elt :title))))
(while (< (point) end)
(let* ((next-elt (org-element-at-point))
(elt-type (car next-elt))
(elt (cadr next-elt)))
(when (and (eql 'headline elt-type)
(eql (+ 1 level) (plist-get elt :level)))
(push elt children))
(goto-char (plist-get elt :end)))))
(append elt `(:children ,(reverse children)))))
(defun +org-element-contents (elt)
(if-let ((begin (plist-get (cadr elt) :contents-begin))
(end (plist-get (cadr elt) :contents-end)))
(buffer-substring-no-properties begin end)
""))
(defun org-clubhouse-find-description-drawer ()
"Try to find a DESCRIPTION drawer in the current element."
(let ((elt (org-element-at-point)))
(cl-case (car elt)
('drawer (+org-element-contents elt))
('headline
(when-let ((drawer-pos (string-match
":DESCRIPTION:"
(+org-element-contents elt))))
(save-excursion
(goto-char (+ (plist-get (cadr elt) :contents-begin)
drawer-pos))
(org-clubhouse-find-description-drawer)))))))
(defun org-clubhouse--labels-for-elt (elt)
"Return the Clubhouse labels based on the tags of ELT and the user's config."
(unless (eq nil org-clubhouse-create-stories-with-labels)
(let ((tags (org-get-tags (plist-get elt :contents-begin))))
(-map (lambda (l) `((name . ,l)))
(cl-case org-clubhouse-create-stories-with-labels
('t tags)
('existing (-filter (lambda (tag) (-some (lambda (l)
(string-equal tag (cdr l)))
(org-clubhouse-labels)))
tags)))))))
;;;
;;; API integration
;;;
(defvar org-clubhouse-base-url* "https://api.clubhouse.io/api/v3")
(defun org-clubhouse-auth-url (url &optional params)
(concat url
"?"
(url-build-query-string
(cons `("token" ,org-clubhouse-auth-token) params))))
(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)))))
(cl-defun org-clubhouse-request (method url &key data (params '()))
(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 params)))
(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-get-story
(clubhouse-id)
(org-clubhouse-request "GET" (format "/stories/%s" clubhouse-id)))
(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-milestone (milestone-id)
(format "https://app.clubhouse.io/%s/milestone/%d"
org-clubhouse-team-name
milestone-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 epics as (epic-id . name)"
(org-clubhouse-fetch-as-id-name-pairs "epics"))
(defcache org-clubhouse-milestones
"Returns milestone-id . name)"
(org-clubhouse-fetch-as-id-name-pairs "milestones"))
(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)))
(defcache org-clubhouse-labels
"Returns labels as (label-id . name)"
(org-clubhouse-fetch-as-id-name-pairs "labels"))
(defcache org-clubhouse-whoami
"Returns the ID of the logged in user"
(->> (org-clubhouse-request
"GET"
"/members")
->list
(find-if (lambda (m)
(->> m
(alist-get 'profile)
(alist-get 'mention_name)
(equal org-clubhouse-username))))
(alist-get 'id)))
(defcache org-clubhouse-iterations
"Returns iterations as (iteration-id . name)"
(org-clubhouse-fetch-as-id-name-pairs "iterations"))
(defun org-clubhouse-stories-in-project (project-id)
"Return the stories in the given PROJECT-ID as org headlines."
(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)))))))
(defun org-clubhouse-workflow-state-id-to-todo-keyword (workflow-state-id)
"Convert the named clubhouse WORKFLOW-STATE-ID to an org todo keyword."
(let* ((state-name (alist-get-equal
workflow-state-id
(invert-alist (org-clubhouse-workflow-states))))
(inv-state-name-alist
(-map (lambda (cell) (cons (cdr cell) (car cell)))
org-clubhouse-state-alist)))
(or (alist-get-equal state-name inv-state-name-alist)
(if state-name (s-upcase state-name) "UNKNOWN"))))
;;;
;;; Prompting
;;;
(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
(find-match-in-alist selected (org-clubhouse-projects))))
(funcall cb project-id)))))
(defun org-clubhouse-prompt-for-epic (cb)
"Prompt the user for an epic using ivy and call CB with its ID."
(ivy-read
"Select an epic: "
(-map #'cdr (append '((nil . "No Epic")) (org-clubhouse-epics)))
:history 'org-clubhouse-epic-history
:action (lambda (selected)
(let ((epic-id
(find-match-in-alist selected (org-clubhouse-epics))))
(funcall cb epic-id)))))
(defun org-clubhouse-prompt-for-milestone (cb)
"Prompt the user for a milestone using ivy and call CB with its ID."
(ivy-read
"Select a milestone: "
(-map #'cdr (append '((nil . "No Milestone")) (org-clubhouse-milestones)))
:require-match t
:history 'org-clubhouse-milestone-history
:action (lambda (selected)
(let ((milestone-id
(find-match-in-alist selected (org-clubhouse-milestones))))
(funcall cb milestone-id)))))
(defun org-clubhouse-prompt-for-story-type (cb)
(ivy-read
"Select a story type: "
(-map #'cdr org-clubhouse-story-types)
:history 'org-clubhouse-story-history
:action (lambda (selected)
(let ((story-type
(find-match-in-alist selected org-clubhouse-story-types)))
(funcall cb story-type)))))
(defun org-clubhouse-prompt-for-default-story-type ()
(interactive)
(ivy-read
"Select a default story type: "
(-map #'cdr org-clubhouse-default-story-types)
:history 'org-clubhouse-default-story-history
:action (lambda (selected)
(let ((story-type
(find-match-in-alist selected org-clubhouse-default-story-types)))
(if (string-equal story-type "prompt")
(setq org-clubhouse-default-story-type nil)
(setq org-clubhouse-default-story-type story-type))))))
;;;
;;; Epic creation
;;;
(cl-defun org-clubhouse-create-epic-internal
(title &key milestone-id)
(cl-assert (and (stringp title)
(or (null milestone-id)
(integerp milestone-id))))
(org-clubhouse-request
"POST"
"epics"
:data
(json-encode
`((name . ,title)
(milestone_id . ,milestone-id)))))
(defun org-clubhouse-populate-created-epic (elt epic)
(let ((elt-start (plist-get elt :begin))
(epic-id (alist-get 'id epic))
(milestone-id (alist-get 'milestone_id epic)))
(save-excursion
(goto-char elt-start)
(org-set-property "clubhouse-epic-id"
(org-link-make-string
(org-clubhouse-link-to-epic epic-id)
(number-to-string epic-id)))
(when milestone-id
(org-set-property "clubhouse-milestone"
(org-link-make-string
(org-clubhouse-link-to-milestone milestone-id)
(alist-get milestone-id (org-clubhouse-milestones))))))))
(defun org-clubhouse-create-epic (&optional beg end)
"Creates a clubhouse epic using selected headlines.
Will pull the title from the headline at point, or create epics for all the
headlines in the selected region.
All epics are added to the same milestone, as selected via a prompt.
If the epics already have a CLUBHOUSE-EPIC-ID, they are filtered and ignored."
(interactive
(when (use-region-p)
(list (region-beginning region-end))))
(let* ((elts (org-clubhouse-collect-headlines beg end))
(elts (-remove (lambda (elt) (plist-get elt :CLUBHOUSE-EPIC-ID)) elts)))
(org-clubhouse-prompt-for-milestone
(lambda (milestone-id)
(dolist (elt elts)
(let* ((title (plist-get elt :title))
(epic (org-clubhouse-create-epic-internal
title
:milestone-id milestone-id)))
(org-clubhouse-populate-created-epic elt epic))
elts)))))
;;;
;;; Story creation
;;;
(defun org-clubhouse-default-state-id ()
(alist-get-equal org-clubhouse-default-state (org-clubhouse-workflow-states)))
(cl-defun org-clubhouse-create-story-internal
(title &key project-id epic-id story-type description labels)
(cl-assert (and (stringp title)
(integerp project-id)
(or (null epic-id) (integerp epic-id))
(or (null description) (stringp description))))
(let ((workflow-state-id (org-clubhouse-default-state-id))
(params `((name . ,title)
(project_id . ,project-id)
(epic_id . ,epic-id)
(story_type . ,story-type)
(description . ,(or description ""))
(labels . ,labels))))
(when workflow-state-id
(push `(workflow_state_id . ,workflow-state-id) params))
(org-clubhouse-request
"POST"
"stories"
:data
(json-encode params))))
(cl-defun org-clubhouse-populate-created-story (elt story &key extra-properties)
(let ((elt-start (plist-get elt :begin))
(story-id (alist-get 'id story))
(epic-id (alist-get 'epic_id story))
(project-id (alist-get 'project_id story))
(story-type (alist-get 'story_type story)))
(save-excursion
(goto-char elt-start)
(org-set-property "clubhouse-id"
(org-link-make-string
(org-clubhouse-link-to-story story-id)
(number-to-string story-id)))
(when epic-id
(org-set-property "clubhouse-epic"
(org-link-make-string
(org-clubhouse-link-to-epic epic-id)
(alist-get epic-id (org-clubhouse-epics)))))
(org-set-property "clubhouse-project"
(org-link-make-string
(org-clubhouse-link-to-project project-id)
(alist-get project-id (org-clubhouse-projects))))
(org-set-property "story-type"
(alist-get-equal story-type org-clubhouse-story-types))
(dolist (extra-prop extra-properties)
(org-set-property (car extra-prop)
(alist-get (cdr extra-prop) story)))
(org-todo "TODO"))))
(defun org-clubhouse-create-story (&optional beg end &key then)
"Creates a clubhouse story using selected headlines.
Will pull the title from the headline at point,
or create cards for all the headlines in the selected region.
All stories are added to the same project and epic, as selected via two prompts.
If the stories already have a CLUBHOUSE-ID, they are filtered and ignored."
(interactive
(when (use-region-p)
(list (region-beginning) (region-end))))
(let* ((elts (org-clubhouse-collect-headlines beg end))
(new-elts (-remove (lambda (elt) (plist-get elt :CLUBHOUSE-ID)) elts)))
(org-clubhouse-prompt-for-project
(lambda (project-id)
(when project-id
(org-clubhouse-prompt-for-epic
(lambda (epic-id)
(let ((create-story
(lambda (story-type)
(-map
(lambda (elt)
(let* ((title (plist-get elt :title))
(description
(save-mark-and-excursion
(goto-char (plist-get elt :begin))
(org-clubhouse-find-description-drawer)))
(labels (org-clubhouse--labels-for-elt elt))
(story (org-clubhouse-create-story-internal
title
:project-id project-id
:epic-id epic-id
:story-type story-type
:description description
:labels labels)))
(org-clubhouse-populate-created-story elt story)
(when (functionp then)
(funcall then story))))
new-elts))))
(if org-clubhouse-default-story-type
(funcall create-story org-clubhouse-default-story-type)
(org-clubhouse-prompt-for-story-type create-story))))))))))
(defun org-clubhouse-create-story-with-task-list (&optional beg end)
"Creates a clubhouse story using the selected headline, making all direct
children of that headline into tasks in the task list of the story."
(interactive
(when (use-region-p)
(list (region-beginning) (region-end))))
(let* ((elt (org-element-and-children-at-point)))
(org-clubhouse-create-story nil nil
:then (lambda (story)
(pp story)
(org-clubhouse-push-task-list
(alist-get 'id story)
(plist-get elt :children))))))
;;;
;;; Task creation
;;;
(cl-defun org-clubhouse-create-task (title &key story-id)
(cl-assert (and (stringp title)
(integerp story-id)))
(org-clubhouse-request
"POST"
(format "/stories/%d/tasks" story-id)
:data (json-encode `((description . ,title)))))
(defun org-clubhouse-push-task-list (&optional parent-clubhouse-id child-elts)
"Writes each child of the element at point as a task list item.
When called as (org-clubhouse-push-task-list PARENT-CLUBHOUSE-ID CHILD-ELTS),
allows manually passing a clubhouse ID and list of org-element plists to write"
(interactive)
(let* ((elt (org-element-and-children-at-point))
(parent-clubhouse-id (or parent-clubhouse-id
(org-element-extract-clubhouse-id elt)))
(child-elts (or child-elts (plist-get elt :children)))
(story (org-clubhouse-get-story parent-clubhouse-id))
(existing-tasks (alist-get 'tasks story))
(task-exists
(lambda (task-name)
(cl-some (lambda (task)
(string-equal task-name (alist-get 'description task)))
existing-tasks)))
(elts-with-starts
(-map (lambda (e) (cons (set-marker (make-marker)
(plist-get e :begin))
e))
child-elts)))
(dolist (child-elt-and-start elts-with-starts)
(let* ((start (car child-elt-and-start))
(child-elt (cdr child-elt-and-start))
(task-name (plist-get child-elt :title)))
(unless (funcall task-exists task-name)
(let ((task (org-clubhouse-create-task
task-name
:story-id parent-clubhouse-id)))
(org-clubhouse-populate-created-task child-elt task start)))))))
(defun org-clubhouse-populate-created-task (elt task &optional begin)
(let ((elt-start (or begin (plist-get elt :begin)))
(task-id (alist-get 'id task))
(story-id (alist-get 'story_id task)))
(save-excursion
(goto-char elt-start)
(org-set-property "clubhouse-task-id" (format "%d" task-id))
(org-set-property "clubhouse-story-id"
(org-link-make-string
(org-clubhouse-link-to-story story-id)
(number-to-string story-id)))
(org-todo "TODO"))))
;;;
;;; Task Updates
;;;
(cl-defun org-clubhouse-update-task-internal
(story-id task-id &rest attrs)
(cl-assert (and (integerp story-id)
(integerp task-id)
(listp attrs)))
(org-clubhouse-request
"PUT"
(format "stories/%d/tasks/%d" story-id task-id)
:data
(json-encode attrs)))
;;;
;;; Story updates
;;;
(cl-defun org-clubhouse-update-story-internal
(story-id &rest attrs)
(cl-assert (and (integerp story-id)
(listp attrs)))
(org-clubhouse-request
"PUT"
(format "stories/%d" story-id)
:data
(json-encode attrs)))
(cl-defun org-clubhouse-update-story-at-point (&rest attrs)
(when-let* ((clubhouse-id (org-element-clubhouse-id)))
(apply
#'org-clubhouse-update-story-internal
(cons clubhouse-id attrs))
t))
(defun org-clubhouse-update-story-title ()
"Update the title of the Clubhouse story linked to the current headline.
Update the title of the story linked to the current headline with the text of
the headline."
(interactive)
(let* ((elt (org-element-find-headline))
(title (plist-get elt :title))
(clubhouse-id (org-element-clubhouse-id)))
(and
(org-clubhouse-update-story-at-point
clubhouse-id
:name title)
(message "Successfully updated story title to \"%s\""
title))))
(defun org-clubhouse-update-status ()
"Update the status of the Clubhouse story linked to the current element.
Update the status of the Clubhouse story linked to the current element with the
entry in `org-clubhouse-state-alist' corresponding to the todo-keyword of the
element."
(interactive)
(let* ((elt (org-element-find-headline))
(todo-keyword (-> elt
(plist-get :todo-keyword)
(substring-no-properties)))
(clubhouse-id (org-element-extract-clubhouse-id elt))
(task-id (plist-get elt :CLUBHOUSE-TASK-ID)))
(cond
(clubhouse-id
(let* ((todo-keyword (-> elt
(plist-get :todo-keyword)
(substring-no-properties))))
(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))))
(let ((update-assignee?
(if (or (eq 't org-clubhouse-claim-story-on-status-update)
(member todo-keyword
org-clubhouse-claim-story-on-status-update))
(if org-clubhouse-username
't
(warn "Not claiming story since `org-clubhouse-username'
is not set")
nil))))
(if update-assignee?
(org-clubhouse-update-story-internal
clubhouse-id
:workflow_state_id workflow-state-id
:owner_ids (if update-assignee?
(list (org-clubhouse-whoami))
(list)))
(org-clubhouse-update-story-internal
clubhouse-id
:workflow_state_id workflow-state-id))
(message
(if update-assignee?
"Successfully claimed story and updated clubhouse status to \"%s\""
"Successfully updated clubhouse status to \"%s\"")
clubhouse-workflow-state)))))
(task-id
(let ((story-id (org-element-extract-clubhouse-id
elt
:CLUBHOUSE-STORY-ID))
(done? (member todo-keyword org-done-keywords)))
(org-clubhouse-update-task-internal
story-id
(string-to-number task-id)
:complete (if done? 't :json-false))
(message "Successfully marked clubhouse task status as %s"
(if done? "complete" "incomplete")))))))
(defun org-clubhouse-update-description ()
"Update the description of the Clubhouse story linked to the current element.
Update the status of the Clubhouse story linked to the current element with the
contents of a drawer inside the element called DESCRIPTION, if any."
(interactive)
(when-let* ((new-description (org-clubhouse-find-description-drawer)))
(and
(org-clubhouse-update-story-at-point
:description new-description)
(message "Successfully updated story description"))))
(defun org-clubhouse-update-labels ()
"Update the labels of the Clubhouse story linked to the current element.
Will use the value of `org-clubhouse-create-stories-with-labels' to determine
which labels to set."
(interactive)
(when-let* ((elt (org-element-find-headline))
(new-labels (org-clubhouse--labels-for-elt elt)))
(and
(org-clubhouse-update-story-at-point
:labels new-labels)
(message "Successfully updated story labels to :%s:"
(->> new-labels
(-map #'cdar)
(s-join ":"))))))
;;;
;;; Creating headlines from existing stories
;;;
(defun org-clubhouse--task-to-headline-text (level task)
(format "%s %s %s
:PROPERTIES:
:clubhouse-task-id: %s
:clubhouse-story-id: %s
:END:"
(make-string level ?*)
(if (equal :json-false (alist-get 'complete task))
"TODO" "DONE")
(alist-get 'description task)
(alist-get 'id task)
(let ((story-id (alist-get 'story_id task)))
(org-link-make-string
(org-clubhouse-link-to-story story-id)
story-id))))
(defun org-clubhouse--story-to-headline-text (level story)
(let ((story-id (alist-get 'id story)))
(format
"%s %s %s %s
:PROPERTIES:
:clubhouse-id: %s
:END:
%s
%s
"
(make-string level ?*)
(org-clubhouse-workflow-state-id-to-todo-keyword
(alist-get 'workflow_state_id story))
(alist-get 'name story)
(if-let ((labels (->> story
(alist-get 'labels)
->list
(-map (apply-partially #'alist-get 'name)))))
(format ":%s:" (s-join ":" labels))
"")
(org-link-make-string
(org-clubhouse-link-to-story story-id)
(number-to-string story-id))
(let ((desc (alist-get 'description story)))
(if (= 0 (length desc)) ""
(format ":DESCRIPTION:\n%s\n:END:" desc)))
(if-let ((tasks (seq-sort-by
(apply-partially #'alist-get 'position)
#'<
(or (alist-get 'tasks story)
(alist-get 'tasks
(org-clubhouse-get-story story-id))))))
(mapconcat (apply-partially #'org-clubhouse--task-to-headline-text
(1+ level))
tasks
"\n")
""))))
(defun org-clubhouse-headline-from-my-tasks (level)
"Prompt my active stories and create a single `org-mode' headline at LEVEL."
(interactive "*nLevel: \n")
(if org-clubhouse-username
(let* ((story-list (org-clubhouse--search-stories
(format "owner:%s !is:done !is:archived"
org-clubhouse-username)))
(stories (to-id-name-pairs story-list)))
(org-clubhouse-headline-from-story-id level
(find-match-in-alist
(ivy-read "Select Story: "
(-map #'cdr stories))
stories)))
(warn "Can't fetch my tasks if `org-clubhouse-username' is unset")))
(defun org-clubhouse-headline-from-story-id (level story-id)
"Create a single `org-mode' headline at LEVEL based on the given clubhouse STORY-ID."
(interactive "*nLevel: \nnStory ID: ")
(let* ((story (org-clubhouse-get-story story-id)))
(if (equal '((message . "Resource not found.")) story)
(message "Story ID not found: %d" story-id)
(save-mark-and-excursion
(insert (org-clubhouse--story-to-headline-text level story))
(org-align-tags)))))
(defun org-clubhouse--search-stories (query)
(unless (string= "" query)
(-> (org-clubhouse-request "GET" "search/stories" :params `((query ,query)))
cdadr
(append nil)
reject-archived)))
(defun org-clubhouse-prompt-for-iteration (cb)
"Prompt for iteration and call CB with that iteration"
(ivy-read
"Select an interation: "
(-map #'cdr (org-clubhouse-iterations))
:require-match t
:history 'org-clubhouse-iteration-history
:action (lambda (selected)
(let ((iteration-id
(find-match-in-alist selected (org-clubhouse-iterations))))
(funcall cb iteration-id)))))
(defun org-clubhouse--get-iteration (iteration-id)
(-> (org-clubhouse-request "GET" (format "iterations/%d/stories" iteration-id))
(append nil)))
(defun org-clubhouse-headlines-from-iteration (level)
"Create `org-mode' headlines from a clubhouse iteration.
Create `org-mode' headlines from all the resulting stories at headline level LEVEL."
(interactive "*nLevel: ")
(org-clubhouse-prompt-for-iteration
(lambda (iteration-id)
(let ((story-list (org-clubhouse--get-iteration iteration-id)))
(if (null story-list)
(message "Iteration id returned no stories: %d" iteration-id)
(let ((text (mapconcat (apply-partially
#'org-clubhouse--story-to-headline-text
level)
(reject-archived story-list) "\n")))
(save-mark-and-excursion
(insert text)
(org-align-all-tags))
text))))))
(defun org-clubhouse-headlines-from-query (level query)
"Create `org-mode' headlines from a clubhouse query.
Submits QUERY to clubhouse, and creates `org-mode' headlines from all the
resulting stories at headline level LEVEL."
(interactive
"*nLevel: \nMQuery: ")
(let* ((story-list (org-clubhouse--search-stories query)))
(if (null story-list)
(message "Query returned no stories: %s" query)
(let ((text (mapconcat (apply-partially
#'org-clubhouse--story-to-headline-text
level)
(reject-archived story-list) "\n")))
(if (called-interactively-p)
(save-mark-and-excursion
(insert text)
(org-align-all-tags))
text)))))
(defun org-clubhouse-prompt-for-story (cb)
"Prompt the user for a clubhouse story, then call CB with the full story."
(ivy-read "Story title: "
(lambda (search-term)
(let* ((stories (org-clubhouse--search-stories
(if search-term (format "\"%s\"" search-term)
""))))
(-map (lambda (story)
(propertize (alist-get 'name story) 'story story))
stories)))
:dynamic-collection t
:history 'org-clubhouse-story-prompt
:action (lambda (s) (funcall cb (get-text-property 0 'story s)))
:require-match t))
(defun org-clubhouse-headline-from-story (level)
"Prompt for a story, and create an org headline at LEVEL from that story."
(interactive "*nLevel: ")
(org-clubhouse-prompt-for-story
(lambda (story)
(save-mark-and-excursion
(insert (org-clubhouse--story-to-headline-text level story))
(org-align-tags)))))
(defun org-clubhouse-link ()
"Link the current `org-mode' headline with an existing clubhouse story."
(interactive)
(org-clubhouse-prompt-for-story
(lambda (story)
(org-clubhouse-populate-created-story
(org-element-find-headline)
story
:extra-properties '(("clubhouse-story-name" . name)))
(org-todo
(org-clubhouse-workflow-state-id-to-todo-keyword
(alist-get 'workflow_state_id story))))))
(defun org-clubhouse-claim ()
"Assign the clubhouse story associated with the headline at point to yourself."
(interactive)
(if org-clubhouse-username
(and
(org-clubhouse-update-story-at-point
:owner_ids (list (org-clubhouse-whoami)))
(message "Successfully claimed story"))
(warn "Can't claim story if `org-clubhouse-username' is unset")))
(defun org-clubhouse-sync-status (&optional beg end)
"Pull the status(es) for the story(ies) in region and update the todo state.
Uses `org-clubhouse-state-alist'. Operates over stories from BEG to END"
(interactive
(when (use-region-p)
(list (region-beginning) (region-end))))
(let ((elts (-filter (lambda (e) (plist-get e :CLUBHOUSE-ID))
(org-clubhouse-collect-headlines beg end))))
(save-mark-and-excursion
(dolist (e elts)
(goto-char (plist-get e :begin))
(let* ((clubhouse-id (org-element-extract-clubhouse-id e))
(story (org-clubhouse-get-story clubhouse-id))
(workflow-state-id (alist-get 'workflow_state_id story))
(todo-keyword (org-clubhouse-workflow-state-id-to-todo-keyword
workflow-state-id)))
(let ((org-after-todo-state-change-hook
(remove 'org-clubhouse-update-status
org-after-todo-state-change-hook)))
(org-todo todo-keyword)))))
(message "Successfully synchronized status of %d stories from Clubhouse"
(length elts))))
(cl-defun org-clubhouse-set-epic (&optional story-id epic-id cb &key beg end)
"Set the epic of clubhouse story STORY-ID to EPIC-ID, then call CB.
When called interactively, prompt for an epic and set the story of the clubhouse
stor{y,ies} at point or region"
(interactive
(when (use-region-p)
(list nil nil nil
:beg (region-beginning)
:end (region-end))))
(if (and story-id epic-id)
(progn
(org-clubhouse-update-story-internal
story-id :epic-id epic-id)
(when cb (funcall cb)))
(let ((elts (-filter (lambda (elt) (plist-get elt :CLUBHOUSE-ID))
(org-clubhouse-collect-headlines beg end))))
(org-clubhouse-prompt-for-epic
(lambda (epic-id)
(-map
(lambda (elt)
(let ((story-id (org-element-extract-clubhouse-id elt)))
(org-clubhouse-set-epic
story-id epic-id
(lambda ()
(org-set-property
"clubhouse-epic"
(org-link-make-string
(org-clubhouse-link-to-epic epic-id)
(alist-get epic-id (org-clubhouse-epics))))
(message "Successfully set the epic on story %d to %d"
story-id epic-id))))))
elts)))))
;;;
(define-minor-mode org-clubhouse-mode
"If enabled, updates to the todo keywords on org headlines will update the
linked ticket in Clubhouse."
: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
Reference in a new issue View git blame Copy permalink