From 57008170b3f2180e52ae16c4e1d745a0c31bbb7f Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Fri, 2 Mar 2018 10:12:50 -0500
Subject: 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
---
 org-clubhouse.el | 421 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 421 insertions(+)
 create mode 100644 org-clubhouse.el

(limited to 'org-clubhouse.el')

diff --git a/org-clubhouse.el b/org-clubhouse.el
new file mode 100644
index 000000000000..a38f7197e0c5
--- /dev/null
+++ b/org-clubhouse.el
@@ -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
-- 
cgit 1.4.1