diff options
Diffstat (limited to 'users/grfn/org-clubhouse/org-clubhouse.el')
| -rw-r--r-- | users/grfn/org-clubhouse/org-clubhouse.el | 1241 |
1 files changed, 0 insertions, 1241 deletions
diff --git a/users/grfn/org-clubhouse/org-clubhouse.el b/users/grfn/org-clubhouse/org-clubhouse.el deleted file mode 100644 index e6e29b575187..000000000000 --- a/users/grfn/org-clubhouse/org-clubhouse.el +++ /dev/null @@ -1,1241 +0,0 @@ -;;; 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 |