diff options
Diffstat (limited to 'pearl.el')
| -rw-r--r-- | pearl.el | 3527 |
1 files changed, 3527 insertions, 0 deletions
diff --git a/pearl.el b/pearl.el new file mode 100644 index 0000000..7e1b2cf --- /dev/null +++ b/pearl.el @@ -0,0 +1,3527 @@ +;;; pearl.el --- Linear.app integration -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 +;; Author: Craig Jennings <c@cjennings.net> +;; Based on and inspired by Gael Blanchemain's linear-emacs. +;; Version: 1.0.0 +;; Package-Requires: ((emacs "27.1") (request "0.3.0") (dash "2.17.0") (s "1.12.0") (transient "0.3.0")) +;; Keywords: tools +;; URL: https://github.com/cjennings/pearl + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; pearl integrates Linear.app issue tracking with Emacs and org-mode. +;; Fetch your issues -- open issues, a project, an ad-hoc filter, a Linear +;; Custom View, or a named saved query -- into a single self-describing org +;; file: each issue is a heading, its description and comments render in the +;; body, and its structured fields live in a namespaced LINEAR-* drawer. +;; +;; Edit a description or title and push it back with conflict-aware sync; set +;; priority, state, assignee, or labels by command; add comments; and create +;; or delete issues -- all without leaving Emacs. See README.org for the full +;; command surface and configuration. + +;;; Code: + +;; +;; This file is organized into the following sections: +;; +;; - Dependencies and requirements +;; - Customization and variables +;; - Core API functions (async-first) +;; - Team management functions +;; - Issue management functions +;; - Issue state management functions +;; - Org-mode integration functions +;; - Mapping functions (between Linear and org-mode) +;; - User-facing commands +;; - Org-mode sync hooks +;; - Backward compatibility functions +;; + +;; Dependencies +(require 'request) +(require 'json) +(require 'dash) +(require 's) +(require 'org) +(require 'cl-lib) +(require 'transient) + +;;; Customization and Variables +(defgroup pearl nil + "Integration with Linear issue tracking." + :group 'tools + :prefix "pearl-") + +(defcustom pearl-api-key nil + "API key for Linear.app. +Can be set manually or loaded from LINEAR_API_KEY environment variable +using `pearl-load-api-key-from-env'." + :type 'string + :group 'pearl) + +(defcustom pearl-graphql-url "https://api.linear.app/graphql" + "GraphQL endpoint URL for Linear API." + :type 'string + :group 'pearl) + +(defcustom pearl-default-team-id nil + "Default team ID to use for creating issues. +When set, skips team selection prompt when creating new issues." + :type 'string + :group 'pearl) + +(defcustom pearl-debug nil + "Enable debug logging for Linear requests. +When enabled, detailed API request and response information will be +logged to the *Messages* buffer." + :type 'boolean + :group 'pearl) + +(defcustom pearl-org-file-path (expand-file-name "gtd/linear.org" org-directory) + "Path to the org file where Linear issues are stored. +This file is created or updated by `pearl-list-issues'. +Defaults to \\='gtd/linear.org\\=' in your `org-directory'." + :type 'file + :group 'pearl) + +(defcustom pearl-state-to-todo-mapping + '(("Todo" . "TODO") + ("In Progress" . "IN-PROGRESS") + ("In Review" . "IN-REVIEW") + ("Backlog" . "BACKLOG") + ("Blocked" . "BLOCKED") + ("Done" . "DONE")) + "Mapping between Linear state names and Org TODO keywords, for rendering. +Each element is a cons cell (LINEAR-STATE . ORG-STATE). It controls how a +Linear state renders as an Org TODO keyword and how an Org keyword maps back +on sync. It no longer decides which issues appear: inclusion is now a +server-side query concern (see `pearl-list-issues'). A Linear state +not listed here renders with the default TODO keyword." + :type '(alist :key-type string :value-type string) + :group 'pearl) + +(defcustom pearl-async-default t + "Use async API calls by default. +When t, all API calls will be asynchronous unless explicitly overridden. +Set to nil to use synchronous calls by default for backward compatibility." + :type 'boolean + :group 'pearl) + +(defcustom pearl-progress-messages t + "Show progress messages during long operations. +When enabled, displays messages about ongoing API operations." + :type 'boolean + :group 'pearl) + +(defcustom pearl-max-issue-pages 10 + "Maximum number of issue pages to fetch, at 100 issues per page. +`pearl-list-issues' stops after this many pages and warns that the +result may be truncated. Raise it if you are assigned more issues than +this cap can hold." + :type 'integer + :group 'pearl) + +(defcustom pearl-request-timeout 30 + "Seconds a synchronous Linear request waits before giving up. +The synchronous wrappers busy-wait for their async counterpart to call +back. If it never does (dropped connection, server stall), they return +nil after this many seconds rather than hanging Emacs." + :type 'number + :group 'pearl) + +(defcustom pearl-surface-buffer t + "When non-nil, surface the active org buffer after a command updates it. +A command run while the buffer is buried (its async result lands after you have +navigated away) brings the buffer back to a window so the result is visible. +Set to nil to leave window layout untouched." + :type 'boolean + :group 'pearl) + +(defcustom pearl-surface-select-window nil + "When non-nil, surfacing the active buffer also selects its window. +With the default nil, `pearl-surface-buffer' shows the buffer via +`display-buffer' without moving focus. Set non-nil to have focus follow +\(via `pop-to-buffer') so point lands in the surfaced buffer." + :type 'boolean + :group 'pearl) + +(defun pearl--surface-buffer (buffer) + "Bring BUFFER to a window after a command updated it, unless already shown. +No-op when `pearl-surface-buffer' is nil, BUFFER is dead, or BUFFER is already +visible in some window (so the common already-on-screen case causes no window +churn). Uses `pop-to-buffer' when `pearl-surface-select-window' is non-nil +\(focus follows) and `display-buffer' otherwise (shown without stealing focus)." + (when (and pearl-surface-buffer + (buffer-live-p buffer) + (not (get-buffer-window buffer t))) + (if pearl-surface-select-window + (pop-to-buffer buffer) + (display-buffer buffer)))) + +(defcustom pearl-fold-after-update t + "When non-nil, re-fold the Linear page after a fetch or refresh repopulates it. +`#+STARTUP:' visibility only applies on a file's first visit, so a repopulation +that replaces a visited buffer's contents in place would otherwise leave the +page fully expanded. Folding restores the scannable outline -- issue headings +visible, descriptions, comments, and property drawers hidden. Set to nil to +leave the buffer expanded after updates." + :type 'boolean + :group 'pearl) + +(defun pearl--hide-all-drawers () + "Collapse every property drawer in the current buffer, across Org versions." + (cond ((fboundp 'org-fold-hide-drawer-all) (org-fold-hide-drawer-all)) + ((fboundp 'org-cycle-hide-drawers) (org-cycle-hide-drawers 'all)))) + +(defun pearl--restore-page-visibility () + "Re-fold the whole current buffer to its `#+STARTUP' visibility and hide drawers. +Used after a full repopulation (list / view / merge refresh) so the page does +not sprawl open. A no-op when `pearl-fold-after-update' is nil." + (when pearl-fold-after-update + ;; A full in-place rebuild (Branch B / merge) leaves Org's parsed startup + ;; options stale -- the new `#+STARTUP:' text is in the buffer but + ;; `org-startup-folded' still holds the value read on first visit. Re-read + ;; the options so the fold honors the buffer's actual `#+STARTUP'. + (when (fboundp 'org-set-regexps-and-options) (org-set-regexps-and-options)) + ;; `org-set-startup-visibility' was renamed in Org 9.6; funcall picks the + ;; available name without tripping the byte-compiler's obsoletion warning. + (funcall (if (fboundp 'org-cycle-set-startup-visibility) + 'org-cycle-set-startup-visibility + 'org-set-startup-visibility)) + (pearl--hide-all-drawers))) + +(defvar pearl-todo-states-pattern nil + "Cached regex pattern for matching Org TODO states. +This pattern is generated from `pearl-state-to-todo-mapping'. +Use `pearl--get-todo-states-pattern' to get the pattern.") + +(defvar pearl--todo-states-pattern-source nil + "Mapping the cached pattern was built from. +Holds the `pearl-state-to-todo-mapping' value used to build +`pearl-todo-states-pattern', so the cache can be invalidated +when the mapping changes.") + +;; Cache variables +(defvar pearl--cache-issues nil + "Cache for issues.") + +(defvar pearl--cache-teams nil + "Cache for teams.") + +(defvar pearl--cache-states nil + "Cache of workflow states per team, an alist of (TEAM-ID . STATES). +Populated on first state lookup; clear it to force a refresh.") + +(defvar pearl--cache-team-collections nil + "Cache of per-team collections for name->id resolution. +An alist keyed by (KIND . TEAM-ID) where KIND is one of `projects', +`labels', `members', `cycles'; the value is the list of nodes. Clear it (or +pass a force argument) to refresh.") + +(defvar pearl--cache-views nil + "Cache of the workspace's Linear Custom Views (a list of node alists). +Populated on first listing; clear it (or pass a force argument) to refresh.") + +(defvar pearl--cache-viewer nil + "Cached current-viewer plist (:id :name), fetched once per session. +Backs the comment-edit permission check; clear it to force a refresh.") + +;; Progress tracking variables +(defvar pearl--active-requests 0 + "Number of currently active API requests.") + +;;; Core API Functions (Async-First Architecture) + +(defun pearl--headers () + "Return headers for Linear API requests." + (unless pearl-api-key + (error "Linear API key not set. Use M-x customize-variable RET pearl-api-key")) + + ;; For personal API keys, the format is: "Authorization: <API_KEY>" + ;; No "Bearer" prefix for personal API keys + `(("Content-Type" . "application/json") + ("Authorization" . ,pearl-api-key))) + +(defun pearl--log (format-string &rest args) + "Log message with FORMAT-STRING and ARGS if debug is enabled." + (when pearl-debug + (apply #'message (concat "[Linear] " format-string) args))) + +(defun pearl--progress (format-string &rest args) + "Show a progress message built from FORMAT-STRING and ARGS. +Shown only when `pearl-progress-messages' is non-nil." + (when pearl-progress-messages + (apply #'message (concat "[Linear] " format-string) args))) + +(defun pearl--wait-for (predicate) + "Busy-wait until PREDICATE is non-nil or the request timeout elapses. +Return the final value of PREDICATE: non-nil when it succeeded, nil when +the wait timed out after `pearl-request-timeout' seconds. This +keeps the synchronous wrappers from hanging Emacs when a callback never +fires." + (let ((deadline (+ (float-time) pearl-request-timeout))) + (while (and (not (funcall predicate)) + (< (float-time) deadline)) + (sleep-for 0.1)) + (funcall predicate))) + +(defun pearl--graphql-request-async (query &optional variables success-fn error-fn) + "Make an asynchronous GraphQL request to Linear API. +QUERY is the GraphQL query string. +VARIABLES is an optional alist of variables to include in the request. +SUCCESS-FN is called with the response data on success. +ERROR-FN is called with error information on failure. +If SUCCESS-FN or ERROR-FN are not provided, default handlers will be used." + (pearl--log "Making async GraphQL request with query: %s" query) + (when variables + (pearl--log "Variables: %s" (prin1-to-string variables))) + + (setq pearl--active-requests (1+ pearl--active-requests)) + + (unless success-fn + (setq success-fn (lambda (data) + (pearl--log "Request completed: %s" (prin1-to-string data))))) + + (unless error-fn + (setq error-fn (lambda (error-thrown _response data) + (message "Linear API error: %s" error-thrown) + (pearl--log "Error response: %s" (prin1-to-string data))))) + + (let ((request-data (json-encode `(("query" . ,query) + ,@(when variables `(("variables" . ,variables))))))) + (pearl--log "Request payload: %s" request-data) + + (request + pearl-graphql-url + :type "POST" + :headers (pearl--headers) + :data request-data + :parser 'json-read + :success (cl-function + (lambda (&key data &allow-other-keys) + (setq pearl--active-requests (1- pearl--active-requests)) + (pearl--log "Response received: %s" (prin1-to-string data)) + (funcall success-fn data))) + :error (cl-function + (lambda (&key error-thrown response data &allow-other-keys) + (setq pearl--active-requests (1- pearl--active-requests)) + (pearl--log "Error: %s" error-thrown) + ;; Guard the status-code read: `response' can be nil on some + ;; transport failures, and the accessor errors on a non-struct. + (when (request-response-p response) + (pearl--log "Response status: %s" + (request-response-status-code response))) + (when data + (pearl--log "Error response: %s" (prin1-to-string data))) + (funcall error-fn error-thrown response data)))))) + +(defun pearl--graphql-request (query &optional variables) + "Synchronous wrapper for GraphQL requests (backward compatibility). +QUERY is the GraphQL query string. +VARIABLES is an optional alist of variables. +Returns the response data or nil on error. +This function blocks until the request completes." + (pearl--log "Making synchronous GraphQL request (backward compatibility mode)") + (let ((response nil) + (error-response nil) + (completed nil)) + + (pearl--graphql-request-async + query + variables + (lambda (data) + (setq response data) + (setq completed t)) + (lambda (error-thrown _response _data) + (setq error-response error-thrown) + (setq completed t))) + + ;; Legacy busy-wait: this wrapper predates `pearl--wait-for' and keeps its + ;; own hardcoded 30s bound rather than honoring `pearl-request-timeout'. + (let ((timeout 30) + (start-time (current-time))) + (while (and (not completed) + (< (float-time (time-subtract (current-time) start-time)) timeout)) + (sleep-for 0.1))) + + (if error-response + (progn + (message "Linear API error: %s" error-response) + nil) + response))) + +;;; Team Management (Async) + +(defun pearl-get-teams-async (&optional callback) + "Asynchronously get a list of teams from Linear. +CALLBACK is called with the list of teams on success." + (pearl--log "Fetching teams asynchronously") + (pearl--progress "Fetching teams...") + + (let* ((query "query { teams { nodes { id name } } }") + (success-fn (lambda (response) + (if response + (let ((teams (cdr (assoc 'nodes (assoc 'teams (assoc 'data response)))))) + (pearl--log "Retrieved %d teams" (length teams)) + (setq pearl--cache-teams teams) + (when callback + (funcall callback teams))) + (message "Failed to retrieve teams") + (when callback + (funcall callback nil))))) + (error-fn (lambda (_error _response _data) + (message "Failed to retrieve teams") + (when callback + (funcall callback nil))))) + + (pearl--graphql-request-async query nil success-fn error-fn))) + +(defun pearl-get-teams () + "Get a list of teams from Linear (synchronous for backward compatibility)." + (let ((teams nil) + (completed nil)) + + (pearl-get-teams-async + (lambda (result) + (setq teams result) + (setq completed t))) + + (pearl--wait-for (lambda () completed)) + + teams)) + +(defun pearl-select-team-async (callback) + "Asynchronously prompt user to select a team. +CALLBACK is called with the selected team." + (if pearl--cache-teams + ;; Use cached teams + (let* ((team-names (mapcar (lambda (team) + (cons (cdr (assoc 'name team)) team)) + pearl--cache-teams)) + (selected (completing-read "Select team: " team-names nil t))) + (funcall callback (cdr (assoc selected team-names)))) + ;; Fetch teams first + (pearl-get-teams-async + (lambda (teams) + (if teams + (let* ((team-names (mapcar (lambda (team) + (cons (cdr (assoc 'name team)) team)) + teams)) + (selected (completing-read "Select team: " team-names nil t))) + (funcall callback (cdr (assoc selected team-names)))) + (funcall callback nil)))))) + +(defun pearl-select-team () + "Prompt user to select a team (synchronous for backward compatibility)." + (let ((result nil) + (completed nil)) + + (pearl-select-team-async + (lambda (team) + (setq result team) + (setq completed t))) + + (pearl--wait-for (lambda () completed)) + + result)) + +;;; Issue Filter DSL (Layer 1) + +;; A pure compiler from an authoring plist to a Linear `IssueFilter' object (a +;; json-encodable alist passed as the `$filter' variable of an `issues(filter:)' +;; query). Name->id resolution for `:project' / `:cycle' happens upstream; this +;; layer assumes resolved values and never touches the network. + +(defconst pearl--open-state-types '("completed" "canceled" "duplicate") + "Workflow-state types that count as not open. +`:open t' compiles to a `state.type' nin this list. Linear's state types are +triage, backlog, unstarted, started, completed, canceled, and duplicate; the +first four are the open ones.") + +(defconst pearl--priority-symbols + '((none . 0) (urgent . 1) (high . 2) (medium . 3) (low . 4)) + "Alist mapping priority symbols to Linear's numeric priority values.") + +(defconst pearl--filter-keys + '(:assignee :open :state :state-type :project :team :labels :priority :cycle + :sort :order) + "Keys recognized in an issue-filter authoring plist. +`:sort' and `:order' steer result ordering, not the `IssueFilter' itself.") + +(defun pearl--eq (value) + "Return a Linear comparator alist matching VALUE exactly." + (list (cons "eq" value))) + +(defun pearl--in (values) + "Return a Linear comparator alist matching any of VALUES. +VALUES is a list, encoded as a JSON array." + (list (cons "in" (vconcat values)))) + +(defun pearl--nin (values) + "Return a Linear comparator alist matching none of VALUES. +VALUES is a list, encoded as a JSON array." + (list (cons "nin" (vconcat values)))) + +(defun pearl--compile-priority (priority) + "Return Linear's numeric value for PRIORITY. +PRIORITY is an integer 0-4 or a symbol in `pearl--priority-symbols'." + (cond ((integerp priority) priority) + ((assq priority pearl--priority-symbols) + (cdr (assq priority pearl--priority-symbols))) + (t (error "Invalid priority: %S" priority)))) + +(defun pearl--compile-state-filter (plist) + "Return the state sub-filter alist for PLIST, or nil when no state key is set. +An explicit `:state' (name) or `:state-type' (one type or a list) takes +precedence over `:open', the broad not-closed predicate." + (let ((state (plist-get plist :state)) + (state-type (plist-get plist :state-type)) + (open (plist-get plist :open))) + (cond + (state (list (cons "name" (pearl--eq state)))) + (state-type (list (cons "type" + (pearl--in (if (listp state-type) + state-type + (list state-type)))))) + (open (list (cons "type" (pearl--nin pearl--open-state-types)))) + (t nil)))) + +(defun pearl--build-issue-filter (plist) + "Compile filter PLIST into a json-encodable Linear `IssueFilter' alist. +The result is meant for the `$filter' variable of an `issues(filter:)' query; +sibling keys are AND-ed by Linear. This function is pure and assumes +`:project' / `:cycle' values are already resolved ids (see the resolution +helpers for name->id). Recognized keys are `pearl--filter-keys', minus +the ordering keys `:sort' / `:order'." + (let (filter) + (let ((assignee (plist-get plist :assignee))) + (cond ((eq assignee :me) + (push (cons "assignee" (list (cons "isMe" (pearl--eq t)))) filter)) + ((stringp assignee) + (push (cons "assignee" (list (cons "email" (pearl--eq assignee)))) + filter)))) + (let ((state-filter (pearl--compile-state-filter plist))) + (when state-filter (push (cons "state" state-filter) filter))) + (let ((project (plist-get plist :project))) + (when project + (push (cons "project" (list (cons "id" (pearl--eq project)))) filter))) + (let ((team (plist-get plist :team))) + (when team + (push (cons "team" (list (cons "key" (pearl--eq team)))) filter))) + (let ((labels (plist-get plist :labels))) + ;; v1 semantics: "carries any of these labels" -- labels.some.name in set. + (when labels + (push (cons "labels" + (list (cons "some" (list (cons "name" (pearl--in labels)))))) + filter))) + (let ((priority (plist-get plist :priority))) + (when priority + (push (cons "priority" + (pearl--eq (pearl--compile-priority priority))) + filter))) + (let ((cycle (plist-get plist :cycle))) + (when cycle + (push (cons "cycle" (list (cons "id" (pearl--eq cycle)))) filter))) + (nreverse filter))) + +(defun pearl--validate-issue-filter (plist) + "Validate issue-filter PLIST, signaling a `user-error' on any problem. +Return t when PLIST is well-formed. Checks plist shape, unknown keys, the +`:priority' range/symbol, the `:assignee' form, the `:order' value, empty +strings, and the `:labels' type. Name ambiguity (a project or state name that +needs team context) is resolved upstream, not here." + (unless (and (listp plist) (cl-evenp (length plist))) + (user-error "Issue filter must be a plist")) + (cl-loop for (key _val) on plist by #'cddr + unless (memq key pearl--filter-keys) + do (user-error "Unknown issue-filter key: %S" key)) + (let ((priority (plist-get plist :priority))) + (when priority + (cond ((integerp priority) + (unless (<= 0 priority 4) + (user-error "Priority integer must be 0-4, got %d" priority))) + ((not (assq priority pearl--priority-symbols)) + (user-error "Invalid :priority %S (use 0-4 or none/urgent/high/medium/low)" + priority))))) + (let ((assignee (plist-get plist :assignee))) + (when (and assignee (not (eq assignee :me)) (not (stringp assignee))) + (user-error ":assignee must be :me or an email string, got %S" assignee))) + (let ((order (plist-get plist :order))) + (when (and order (not (memq order '(asc desc)))) + (user-error ":order must be `asc' or `desc', got %S" order))) + (dolist (key '(:state :project :team :cycle)) + (let ((val (plist-get plist key))) + (when (and (stringp val) (string-empty-p val)) + (user-error "%s must not be an empty string" key)))) + (let ((labels (plist-get plist :labels))) + (when (and labels + (or (not (listp labels)) + (cl-some (lambda (x) (not (and (stringp x) (not (string-empty-p x))))) + labels))) + (user-error ":labels must be a list of non-empty strings"))) + t) + +;;; Issue Model Normalization + +;; Convert raw Linear response alists (json-read shaped: symbol keys, vectors +;; for arrays, t / `:json-false' booleans, and a missing key for an absent +;; field) into flat internal plists, so rendering, filtering, and command code +;; never has to know the transport shape. + +(defun pearl--node-list (connection) + "Return CONNECTION's nodes as a list. +CONNECTION is an alist with a `nodes' key holding a vector, a list, or nil." + (let ((nodes (cdr (assoc 'nodes connection)))) + (cond ((vectorp nodes) (append nodes nil)) + ((listp nodes) nodes) + (t nil)))) + +(defun pearl--normalize-user (raw) + "Normalize a Linear user alist RAW to a plist, or nil when RAW is nil." + (when raw + (list :id (cdr (assoc 'id raw)) + :name (or (cdr (assoc 'name raw)) (cdr (assoc 'displayName raw))) + :email (cdr (assoc 'email raw))))) + +(defun pearl--normalize-state (raw) + "Normalize a Linear workflow-state alist RAW to a plist, or nil." + (when raw + (list :id (cdr (assoc 'id raw)) + :name (cdr (assoc 'name raw)) + :type (cdr (assoc 'type raw))))) + +(defun pearl--normalize-team (raw) + "Normalize a Linear team alist RAW to a plist, or nil." + (when raw + (list :id (cdr (assoc 'id raw)) + :key (cdr (assoc 'key raw)) + :name (cdr (assoc 'name raw))))) + +(defun pearl--normalize-project (raw) + "Normalize a Linear project alist RAW to a plist, or nil." + (when raw + (list :id (cdr (assoc 'id raw)) + :name (cdr (assoc 'name raw))))) + +(defun pearl--normalize-labels (raw) + "Normalize an issue's labels connection RAW to a list of (:id :name) plists." + (mapcar (lambda (label) + (list :id (cdr (assoc 'id label)) :name (cdr (assoc 'name label)))) + (pearl--node-list raw))) + +(defun pearl--normalize-comment (raw) + "Normalize a Linear comment alist RAW to a plist. +The author falls back through user, then botActor, then externalUser, because +`Comment.user' is null for integration and bot comments." + (let ((user (pearl--normalize-user (cdr (assoc 'user raw)))) + (bot (cdr (assoc 'botActor raw))) + (ext (cdr (assoc 'externalUser raw)))) + (list :id (cdr (assoc 'id raw)) + :body (cdr (assoc 'body raw)) + :created-at (cdr (assoc 'createdAt raw)) + :author-id (when user (plist-get user :id)) + :author (cond (user (plist-get user :name)) + (bot (or (cdr (assoc 'name bot)) "automation")) + (ext (or (cdr (assoc 'name ext)) "external")) + (t nil))))) + +(defun pearl--normalize-cycle (raw) + "Normalize a Linear cycle alist RAW to a plist, or nil." + (when raw + (list :id (cdr (assoc 'id raw)) + :number (cdr (assoc 'number raw)) + :name (cdr (assoc 'name raw))))) + +(defun pearl--normalize-issue (raw) + "Normalize a Linear issue node RAW to a flat internal plist, or nil. +Vectors become lists and absent/`:json-false' fields become nil. Nested +objects (state, assignee, team, project, labels, cycle, comments) are +normalized in turn; comments are omitted unless the fetch requested them." + (when raw + (list :id (cdr (assoc 'id raw)) + :identifier (cdr (assoc 'identifier raw)) + :title (cdr (assoc 'title raw)) + :description (cdr (assoc 'description raw)) + :priority (cdr (assoc 'priority raw)) + :url (cdr (assoc 'url raw)) + :updated-at (cdr (assoc 'updatedAt raw)) + :state (pearl--normalize-state (cdr (assoc 'state raw))) + :assignee (pearl--normalize-user (cdr (assoc 'assignee raw))) + :team (pearl--normalize-team (cdr (assoc 'team raw))) + :project (pearl--normalize-project (cdr (assoc 'project raw))) + :labels (pearl--normalize-labels (cdr (assoc 'labels raw))) + :cycle (pearl--normalize-cycle (cdr (assoc 'cycle raw))) + :comments (let ((comments (assoc 'comments raw))) + (when comments + (mapcar #'pearl--normalize-comment + (pearl--node-list (cdr comments)))))))) + +(defun pearl--normalize-custom-view (raw) + "Normalize a Linear custom-view alist RAW to a plist, or nil. +A workspace-wide view has a nil `:team'; `:shared' is a real boolean." + (when raw + (list :id (cdr (assoc 'id raw)) + :name (cdr (assoc 'name raw)) + :description (cdr (assoc 'description raw)) + :shared (eq t (cdr (assoc 'shared raw))) + :icon (cdr (assoc 'icon raw)) + :color (cdr (assoc 'color raw)) + :team (pearl--normalize-team (cdr (assoc 'team raw))) + :owner (pearl--normalize-user (cdr (assoc 'owner raw)))))) + +;;; Query Result Shape + +;; A small tagged result so callers can tell apart success-with-issues, +;; success-with-none, an invalid filter (caught before the request), a +;; transport failure, and a GraphQL-level failure, instead of collapsing them +;; all to nil. A result is a plist: (:status SYM :issues LIST :message STR +;; :truncated BOOL). The fetch layer builds one; commands read it to message +;; the user precisely. + +(defun pearl--make-query-result (status &rest props) + "Build a query-result plist with STATUS and optional PROPS. +STATUS is one of `ok', `empty', `invalid-filter', `request-failed', or +`graphql-failed'. PROPS may set `:issues', `:message', and `:truncated'." + (append (list :status status) props)) + +(defun pearl--query-result-status (result) + "Return the status symbol of query RESULT." + (plist-get result :status)) + +(defun pearl--query-result-issues (result) + "Return the issues list carried by query RESULT." + (plist-get result :issues)) + +(defun pearl--query-result-message (result) + "Return the user-facing message carried by query RESULT, if any." + (plist-get result :message)) + +(defun pearl--query-result-truncated-p (result) + "Return non-nil when query RESULT was cut off at the page cap." + (plist-get result :truncated)) + +(defun pearl--query-result-ok-p (result) + "Return non-nil when RESULT is a successful query (issues or empty)." + (memq (pearl--query-result-status result) '(ok empty))) + +(defun pearl--query-result-error-p (result) + "Return non-nil when RESULT is a failure rather than a result set." + (memq (pearl--query-result-status result) + '(invalid-filter request-failed graphql-failed))) + +(defun pearl--graphql-error-message (response) + "Return the first GraphQL error message in RESPONSE, or nil. +RESPONSE's `errors' may be a vector (live API) or a list (test fixtures)." + (let ((errors (cdr (assoc 'errors response)))) + (when errors + (let ((first (if (vectorp errors) + (and (> (length errors) 0) (aref errors 0)) + (car errors)))) + (cdr (assoc 'message first)))))) + +(defun pearl--classify-response (response &optional issues truncated) + "Classify a raw GraphQL RESPONSE into a query-result plist. +A nil RESPONSE, or one without a `data' key, is a transport failure; a RESPONSE +carrying `errors' is a GraphQL failure. Otherwise the result is `ok', or +`empty' when ISSUES is empty, carrying ISSUES and the TRUNCATED flag. ISSUES +is the already-extracted (normalized) list, so this stays pure." + (cond + ((null response) + (pearl--make-query-result 'request-failed + :message "No response from Linear")) + ((assoc 'errors response) + (pearl--make-query-result + 'graphql-failed + :message (or (pearl--graphql-error-message response) + "Linear returned an error"))) + ((not (assoc 'data response)) + (pearl--make-query-result 'request-failed + :message "Malformed response from Linear")) + (t (pearl--make-query-result (if issues 'ok 'empty) + :issues issues + :truncated (and truncated t))))) + +(defun pearl--invalid-filter-result (message) + "Return an `invalid-filter' query-result carrying MESSAGE." + (pearl--make-query-result 'invalid-filter :message message)) + +;;; General Issue Query (Layer 2a) + +;; The general fetch: a top-level `issues(filter:)' query paged through a +;; reusable accumulator, returning a tagged query-result. Issues come back as +;; raw nodes (the query fetches the full field superset); normalization happens +;; at the render boundary, not here. + +(defconst pearl--issues-query + "query Issues($filter: IssueFilter, $first: Int!, $after: String, $orderBy: PaginationOrderBy) { + issues(filter: $filter, first: $first, after: $after, orderBy: $orderBy) { + nodes { + id identifier title description priority url updatedAt + state { id name type } + assignee { id name displayName email } + team { id key name } + project { id name } + labels { nodes { id name } } + cycle { id number name } + comments { nodes { id body createdAt user { id name displayName } botActor { name } externalUser { name } } } + } + pageInfo { hasNextPage endCursor } + } +}" + "GraphQL query for a filtered, ordered page of issues. +Pulls comments per issue so a populated list renders them, not just the +single-issue refresh.") + +(defconst pearl--single-issue-query + "query Issue($id: String!) { + issue(id: $id) { + id identifier title description priority url updatedAt + state { id name type } + assignee { id name displayName email } + team { id key name } + project { id name } + labels { nodes { id name } } + cycle { id number name } + comments { nodes { id body createdAt user { id name displayName } botActor { name } externalUser { name } } } + } +}" + "GraphQL query for one issue by id. +Same field shape as `pearl--issues-query' (which now also pulls comments); +this is the single-issue refresh path.") + +(defun pearl--fetch-issue-async (issue-id callback) + "Fetch the full issue node for ISSUE-ID, calling CALLBACK with the outcome. +CALLBACK receives one of: the raw issue node (normalized at the render +boundary, as on the list path); `:missing' when the request succeeded but the +issue is null (deleted, or no access); or `:error' on a GraphQL or transport +failure. Separating missing from error lets the caller tell \"the issue is +gone\" apart from \"the API call failed.\"" + (pearl--graphql-request-async + pearl--single-issue-query + `(("id" . ,issue-id)) + (lambda (response) + (if (or (null response) + (assoc 'errors response) + (not (assoc 'data response))) + (funcall callback :error) + (let ((issue (cdr (assoc 'issue (cdr (assoc 'data response)))))) + (funcall callback (or issue :missing))))) + (lambda (_error _response _data) (funcall callback :error)))) + +(defconst pearl--view-issues-query + "query ViewIssues($id: String!, $first: Int!, $after: String) { + customView(id: $id) { + issues(first: $first, after: $after) { + nodes { + id identifier title description priority url updatedAt + state { id name type } + assignee { id name displayName email } + team { id key name } + project { id name } + labels { nodes { id name } } + cycle { id number name } + comments { nodes { id body createdAt user { id name displayName } botActor { name } externalUser { name } } } + } + pageInfo { hasNextPage endCursor } + } + } +}" + "GraphQL query running a Custom View's own filter server-side, by view id. +Pulls comments per issue so a view-populated list renders them.") + +(defun pearl--query-view-async (view-id callback) + "Run the Custom View VIEW-ID server-side, calling CALLBACK with a query-result. +The view applies its own stored filter on Linear's side; issues come back as +raw nodes (normalized at the render boundary), paged like the general fetch." + (let ((page-fn + (lambda (after page-cb) + (pearl--graphql-request-async + pearl--view-issues-query + `(("id" . ,view-id) + ("first" . 100) + ,@(when after (list (cons "after" after)))) + (lambda (response) + (if (or (null response) + (assoc 'errors response) + (not (assoc 'data response))) + (funcall page-cb + (list :error (pearl--classify-response response))) + (let* ((conn (cdr (assoc 'issues + (cdr (assoc 'customView + (cdr (assoc 'data response))))))) + (nodes (pearl--node-list conn)) + (info (cdr (assoc 'pageInfo conn)))) + (funcall page-cb + (list :issues nodes + :has-next-page (eq t (cdr (assoc 'hasNextPage info))) + :end-cursor (cdr (assoc 'endCursor info))))))) + (lambda (_error _response _data) + (funcall page-cb + (list :error (pearl--make-query-result + 'request-failed + :message "Failed to fetch view issues")))))))) + (pearl--page-issues page-fn callback))) + +(defun pearl--custom-views (&optional force) + "Return the workspace's Custom Views, fetching once and caching. +Each node carries id/name/description/shared/url. A non-nil FORCE refetches." + (or (and (not force) pearl--cache-views) + (let* ((query "query CustomViews($first: Int!, $after: String) { + customViews(first: $first, after: $after) { + nodes { id name description shared url } + pageInfo { hasNextPage endCursor } + } + }") + (response (pearl--graphql-request query '(("first" . 100)))) + (views (and response + (pearl--node-list + (cdr (assoc 'customViews (cdr (assoc 'data response)))))))) + (when views + (setq pearl--cache-views views)) + views))) + +(defun pearl--page-issues (page-fn callback &optional max-pages) + "Accumulate issues across pages via PAGE-FN, then call CALLBACK with a result. +PAGE-FN is called as (PAGE-FN AFTER PAGE-CB); it fetches one page and invokes +PAGE-CB with a plist (:issues LIST :has-next-page BOOL :end-cursor STR) on +success, or (:error RESULT) carrying a failure query-result. CALLBACK receives +the final query-result. Paging stops at MAX-PAGES (default +`pearl-max-issue-pages'), marking the result truncated." + (let ((max (or max-pages pearl-max-issue-pages)) + (acc '()) + (page 1)) + (cl-labels + ((fetch (after) + (if (> page max) + (funcall callback + (pearl--make-query-result (if acc 'ok 'empty) + :issues acc :truncated t)) + (funcall + page-fn after + (lambda (page-result) + (let ((err (plist-get page-result :error))) + (if err + (funcall callback err) + (setq acc (append acc (plist-get page-result :issues))) + (if (plist-get page-result :has-next-page) + (progn + (setq page (1+ page)) + (fetch (plist-get page-result :end-cursor))) + (funcall callback + (pearl--make-query-result + (if acc 'ok 'empty) :issues acc)))))))))) + (fetch nil)))) + +(defun pearl--query-issues-async (filter callback &optional order-by) + "Fetch issues matching FILTER, calling CALLBACK with a query-result. +FILTER is a compiled `IssueFilter' alist (see +`pearl--build-issue-filter') or nil for no filter. ORDER-BY is a +`PaginationOrderBy' symbol, default `updatedAt'. Issues come back as raw +nodes; normalization happens at the render boundary." + (let ((page-fn + (lambda (after page-cb) + (pearl--graphql-request-async + pearl--issues-query + `(,@(when filter (list (cons "filter" filter))) + ("first" . 100) + ,@(when after (list (cons "after" after))) + ("orderBy" . ,(symbol-name (or order-by 'updatedAt)))) + (lambda (response) + (if (or (null response) + (assoc 'errors response) + (not (assoc 'data response))) + (funcall page-cb + (list :error (pearl--classify-response response))) + (let* ((conn (cdr (assoc 'issues (cdr (assoc 'data response))))) + (nodes (pearl--node-list conn)) + (info (cdr (assoc 'pageInfo conn)))) + (funcall page-cb + (list :issues nodes + :has-next-page (eq t (cdr (assoc 'hasNextPage info))) + :end-cursor (cdr (assoc 'endCursor info))))))) + (lambda (_error _response _data) + (funcall page-cb + (list :error (pearl--make-query-result + 'request-failed + :message "Failed to fetch issues from Linear")))))))) + (pearl--page-issues page-fn callback))) + +;;; Issue Creation + +(defun pearl--created-issue (response) + "Return the created issue node from a create RESPONSE, or nil on failure. +Linear answers GraphQL-level failures with HTTP 200 and either an `errors' +body or `issueCreate.success' = false / `issue' = null. Checking `success' +and the issue node here reports those as failures instead of a phantom +\"created\" issue." + (let* ((issue-create (cdr (assoc 'issueCreate (cdr (assoc 'data response))))) + (success (cdr (assoc 'success issue-create))) + (issue (cdr (assoc 'issue issue-create)))) + (and success (not (eq success :json-false)) issue))) + +(defun pearl-create-issue-async (title description team-id callback) + "Asynchronously create a new issue. +TITLE is the issue title. +DESCRIPTION is the issue description. +TEAM-ID is the team to create the issue in. +CALLBACK is called with the created issue data." + (pearl--log "Creating issue: %s" title) + (pearl--progress "Creating issue...") + + (let* ((query "mutation CreateIssue($title: String!, $description: String, $teamId: String!) { + issueCreate(input: {title: $title, description: $description, teamId: $teamId}) { + success + issue { + id + identifier + title + } + } + }") + (variables `(("title" . ,title) + ("description" . ,description) + ("teamId" . ,team-id))) + + (success-fn (lambda (response) + (let ((issue (pearl--created-issue response))) + (if issue + (progn + (message "Created issue %s: %s" + (cdr (assoc 'identifier issue)) + (cdr (assoc 'title issue))) + (when callback + (funcall callback issue))) + (message "Failed to create issue") + (when callback + (funcall callback nil)))))) + + (error-fn (lambda (_error _response _data) + (message "Failed to create issue") + (when callback + (funcall callback nil))))) + + (pearl--graphql-request-async query variables success-fn error-fn))) + +(defun pearl-create-issue (title description team-id) + "Create a new issue (synchronous wrapper for backward compatibility). +TITLE is the issue title. +DESCRIPTION is the issue description. +TEAM-ID is the team to create the issue in." + (let ((issue nil) + (completed nil)) + + (pearl-create-issue-async + title description team-id + (lambda (result) + (setq issue result) + (setq completed t))) + + (pearl--wait-for (lambda () completed)) + + issue)) + +;;; Issue State Management (Async) + +(defun pearl-get-states-async (team-id callback) + "Asynchronously get workflow states for TEAM-ID. +CALLBACK is called with the list of states." + (pearl--log "Fetching workflow states for team %s" team-id) + + (let* ((query "query GetWorkflowStates($teamId: String!) { + team(id: $teamId) { + states { + nodes { + id + name + color + } + } + } + }") + (variables `(("teamId" . ,team-id))) + + (success-fn (lambda (response) + (when response + (let ((states (cdr (assoc 'nodes (assoc 'states (assoc 'team (assoc 'data response))))))) + (when callback + (funcall callback states)))))) + + (error-fn (lambda (_error _response _data) + (when callback + (funcall callback nil))))) + + (pearl--graphql-request-async query variables success-fn error-fn))) + +(defun pearl-get-states (team-id) + "Get workflow states for TEAM-ID (synchronous wrapper)." + (let ((states nil) + (completed nil)) + + (pearl-get-states-async + team-id + (lambda (result) + (setq states result) + (setq completed t))) + + (pearl--wait-for (lambda () completed)) + + states)) + +(defun pearl--team-states (team-id) + "Return the workflow states for TEAM-ID, fetching once and caching. +Cached in `pearl--cache-states' keyed by TEAM-ID; org-state syncs +resolve a state per heading change, so the cache avoids a network round +trip on every one. Clear the cache to force a refresh." + (or (cdr (assoc team-id pearl--cache-states)) + (let* ((query "query GetTeamWorkflowStates($teamId: String!) { + team(id: $teamId) { + states { + nodes { + id + name + } + } + } + }") + (variables `(("teamId" . ,team-id))) + (response (pearl--graphql-request query variables)) + (states (and response + (cdr (assoc 'nodes + (cdr (assoc 'states + (cdr (assoc 'team + (cdr (assoc 'data response))))))))))) + (when states + (push (cons team-id states) pearl--cache-states)) + states))) + +(defun pearl--get-state-id-by-name (state-name team-id) + "Get the Linear state ID for the given STATE-NAME in TEAM-ID." + (pearl--log "Looking up state ID for %s in team %s" state-name team-id) + (let* ((states (pearl--team-states team-id)) + (state (and states + (seq-find (lambda (s) + (string= (downcase (cdr (assoc 'name s))) + (downcase state-name))) + states)))) + (if state + (cdr (assoc 'id state)) + (message "Could not find state with name: %s in team %s" state-name team-id) + nil))) + +(defun pearl--all-teams () + "Return all teams, fetching once and caching in `pearl--cache-teams'. +The whole-file org sync resolves a team per heading, so caching here turns +N blocking lookups into one. Shares the cache with the team selector." + (or pearl--cache-teams + (let* ((query "query { + teams { + nodes { + id + name + } + } + }") + (response (pearl--graphql-request query)) + (teams (and response + (cdr (assoc 'nodes + (cdr (assoc 'teams + (cdr (assoc 'data response))))))))) + (when teams + (setq pearl--cache-teams teams)) + teams))) + +(defun pearl--get-team-id-by-name (team-name) + "Get the Linear team ID for the given TEAM-NAME." + (pearl--log "Looking up team ID for team %s" team-name) + (let* ((teams (pearl--all-teams)) + (team (and teams + (seq-find (lambda (tm) + (string= (cdr (assoc 'name tm)) team-name)) + teams)))) + (if team + (cdr (assoc 'id team)) + ;; Log the available teams to help diagnose a name mismatch. + (when teams + (pearl--log "Available teams: %s" + (mapconcat (lambda (tm) + (format "%s (%s)" + (cdr (assoc 'name tm)) + (cdr (assoc 'id tm)))) + teams + ", "))) + (message "Could not find team with name: %s" team-name) + nil))) + +;;; Per-team Name -> ID Resolution + +(defun pearl--team-collection (kind team-id &optional force) + "Return the KIND collection for TEAM-ID, fetching once and caching. +KIND is one of `projects', `labels', `members', `cycles'. Cached in +`pearl--cache-team-collections' keyed by (KIND . TEAM-ID); a non-nil +FORCE bypasses the cache and refetches. Returns a list of node alists." + (let ((cache-key (cons kind team-id))) + (if (and (not force) (assoc cache-key pearl--cache-team-collections)) + (cdr (assoc cache-key pearl--cache-team-collections)) + (let* ((fields (pcase kind + ('members "id name displayName email") + ('cycles "id number name") + (_ "id name"))) + (query (format "query TeamCollection($teamId: String!) { + team(id: $teamId) { %s { nodes { %s } } } +}" (symbol-name kind) fields)) + (response (pearl--graphql-request query `(("teamId" . ,team-id)))) + (coll (cdr (assoc kind (cdr (assoc 'team (cdr (assoc 'data response))))))) + (nodes (pearl--node-list coll))) + (when nodes + (push (cons cache-key nodes) pearl--cache-team-collections)) + nodes)))) + +(defun pearl--node-label (kind node) + "Return a human label for NODE of KIND, shown when disambiguating a match." + (pcase kind + ('members (or (cdr (assoc 'displayName node)) + (cdr (assoc 'name node)) + (cdr (assoc 'email node)))) + ('cycles (or (cdr (assoc 'name node)) + (let ((n (cdr (assoc 'number node))) ) (and n (number-to-string n))))) + (_ (cdr (assoc 'name node))))) + +(defun pearl--node-matches-name-p (kind node name) + "Return non-nil when NODE of KIND matches NAME. +Members match name, displayName, or email; cycles match name or number; +everything else matches name. Comparison is case-insensitive." + (let ((needle (downcase name))) + (cl-flet ((eqp (field) + (let ((v (cdr (assoc field node)))) + (and (stringp v) (string= (downcase v) needle))))) + (pcase kind + ('members (or (eqp 'name) (eqp 'displayName) (eqp 'email))) + ('cycles (or (eqp 'name) + (let ((n (cdr (assoc 'number node)))) + (and n (string= (number-to-string n) name))))) + (_ (eqp 'name)))))) + +(defun pearl--resolve-team-id (kind name team-id &optional force) + "Resolve NAME to an id within the KIND collection of TEAM-ID, or nil. +Fetches (and caches) the collection via `pearl--team-collection'. With +a single match, returns its id; with several, prompts the user to pick; with +none, returns nil. FORCE refreshes the collection cache first." + (let* ((nodes (pearl--team-collection kind team-id force)) + (matches (seq-filter (lambda (n) (pearl--node-matches-name-p kind n name)) + nodes))) + (pcase (length matches) + (0 nil) + (1 (cdr (assoc 'id (car matches)))) + (_ (let* ((choices (mapcar (lambda (n) + (cons (format "%s (%s)" + (pearl--node-label kind n) + (cdr (assoc 'id n))) + (cdr (assoc 'id n)))) + matches)) + (pick (completing-read (format "Multiple matches for %s: " name) + choices nil t))) + (cdr (assoc pick choices))))))) + +;;;###autoload +(defun pearl-clear-cache () + "Clear the Linear lookup caches (teams, states, per-team collections, issues). +Use after renaming things in Linear, or to force the next lookup to refetch." + (interactive) + (setq pearl--cache-issues nil + pearl--cache-teams nil + pearl--cache-states nil + pearl--cache-team-collections nil + pearl--cache-views nil + pearl--cache-viewer nil) + (message "Linear caches cleared")) + +(defun pearl-update-issue-state (issue-id state-name team-id) + "Update the state of Linear issue with ISSUE-ID to STATE-NAME for TEAM-ID." + (pearl--log "Updating issue %s state to %s for team %s" issue-id state-name team-id) + ;; Resolve the state name to an ID first; bail out clearly if the team has + ;; no such state rather than firing a mutation with a null stateId. + (let ((state-id (pearl--get-state-id-by-name state-name team-id))) + (if (null state-id) + (message "Cannot update issue %s: no Linear state named %s in team %s" + issue-id state-name team-id) + (let* ((query "mutation UpdateIssueState($issueId: String!, $stateId: String!) { + issueUpdate(id: $issueId, input: {stateId: $stateId}) { + success + issue { + id + identifier + state { + id + name + } + } + } + }") + (variables `(("issueId" . ,issue-id) + ("stateId" . ,state-id))) + (response (pearl--graphql-request query variables))) + (if response + (let ((success (and (assoc 'data response) + (assoc 'issueUpdate (assoc 'data response)) + (cdr (assoc 'success (assoc 'issueUpdate (assoc 'data response))))))) + (if success + (message "Updated issue %s state to %s" issue-id state-name) + (pearl--log "Failed to update issue state: %s" (prin1-to-string response)) + (message "Failed to update issue %s state" issue-id))) + (message "Failed to update issue %s state: API error" issue-id)))))) + +(defun pearl--update-issue-state-async (issue-id state-name team-id) + "Asynchronously update a Linear issue's state. +ISSUE-ID is the Linear issue ID. +STATE-NAME is the target state name to set. +TEAM-ID is the team ID of the issue. +Gives immediate feedback and performs the API update in the background." + (pearl--log "Asynchronously updating issue %s state to %s for team %s" issue-id state-name team-id) + + ;; Resolve the state name to an ID first; bail out clearly if the team has + ;; no such state rather than firing a mutation with a null stateId. + (let ((state-id (pearl--get-state-id-by-name state-name team-id))) + (if (null state-id) + (message "Cannot update issue %s: no Linear state named %s in team %s" + issue-id state-name team-id) + (message "Updating issue state to %s... (in background)" state-name) + (let* ((query "mutation UpdateIssueState($issueId: String!, $stateId: String!) { + issueUpdate(id: $issueId, input: {stateId: $stateId}) { + success + issue { + id + identifier + state { + id + name + } + } + } + }") + (variables `(("issueId" . ,issue-id) + ("stateId" . ,state-id))) + (success-handler (lambda (data) + (let ((success (and (assoc 'data data) + (assoc 'issueUpdate (assoc 'data data)) + (cdr (assoc 'success (assoc 'issueUpdate (assoc 'data data))))))) + (if success + (message "Successfully updated issue %s state to %s" issue-id state-name) + (pearl--log "Failed to update issue state asynchronously: %s" (prin1-to-string data)) + (message "Failed to update issue %s state in Linear" issue-id))))) + (error-handler (lambda (error-thrown _response _data) + (message "Error updating issue %s state in Linear: %s" issue-id error-thrown)))) + + (pearl--graphql-request-async query variables success-handler error-handler))))) + +;;; Team Member and Project Management + +(defun pearl-get-team-members (team-id) + "Get members for the given TEAM-ID." + (pearl--log "Fetching team members for team %s" team-id) + (let* ((query "query GetTeamMembers($teamId: String!) { + team(id: $teamId) { + members { + nodes { + id + name + displayName + } + } + } + }") + (variables `(("teamId" . ,team-id))) + (response (pearl--graphql-request query variables))) + (when response + (let ((members (cdr (assoc 'nodes (assoc 'members (assoc 'team (assoc 'data response))))))) + (pearl--log "Retrieved %d team members" (length members)) + (let ((formatted-members + (mapcar (lambda (member) + (cons (or (cdr (assoc 'displayName member)) + (cdr (assoc 'name member))) + (cdr (assoc 'id member)))) + members))) + (pearl--log "Formatted team members: %s" (prin1-to-string formatted-members)) + formatted-members))))) + +(defun pearl-get-projects (team-id) + "Get a list of projects for the given TEAM-ID." + (pearl--log "Fetching projects for team %s" team-id) + (let* ((query "query GetProjects($teamId: String!) { + team(id: $teamId) { + projects { + nodes { + id + name + description + state + } + } + } +}") + (variables `(("teamId" . ,team-id))) + (response (pearl--graphql-request query variables))) + (when response + (let ((projects (cdr (assoc 'nodes (assoc 'projects (assoc 'team (assoc 'data response))))))) + ;; Convert vector to list if needed + (when (vectorp projects) + (setq projects (append projects nil))) + (pearl--log "Retrieved %d projects" (length projects)) + projects)))) + +(defun pearl-select-project (team-id) + "Prompt user to select a project from TEAM-ID." + (let* ((projects (pearl-get-projects team-id)) + (project-names (when projects + (mapcar (lambda (project) + (cons (cdr (assoc 'name project)) project)) + projects))) + (selected (when project-names + (completing-read "Select project (optional): " + (cons "None" project-names) nil t nil nil "None")))) + (unless (string= selected "None") + (cdr (assoc selected project-names))))) + +;;; Other Issue Attributes + +(defun pearl-get-priorities () + "Get priority options for Linear issues." + ;; Linear uses integers for priorities: 0 (No priority), 1 (Urgent), 2 (High), 3 (Medium), 4 (Low) + '(("No priority" . 0) + ("Urgent" . 1) + ("High" . 2) + ("Medium" . 3) + ("Low" . 4))) + +(defun pearl-get-issue-types (team-id) + "Get issue types for the given TEAM-ID." + (pearl--log "Fetching issue types for team %s" team-id) + (let* ((query "query GetIssueTypes($teamId: String!) { + team(id: $teamId) { + labels { + nodes { + id + name + color + } + } + } + }") + (variables `(("teamId" . ,team-id))) + (response (pearl--graphql-request query variables))) + (when response + (let ((labels (cdr (assoc 'nodes (assoc 'labels (assoc 'team (assoc 'data response))))))) + (mapcar (lambda (label) + (cons (cdr (assoc 'name label)) + (cdr (assoc 'id label)))) + labels))))) + +;;; Org Mode Integration + +(defun pearl-org-hook-function () + "Sync to Linear when the configured Linear org file is saved. +Fires only for the buffer visiting `pearl-org-file-path', so a +custom output path is honored instead of a hardcoded \"linear.org\" name." + (when (and buffer-file-name + pearl-org-file-path + (string-equal (file-truename buffer-file-name) + (file-truename pearl-org-file-path))) + (pearl--log "Linear org file saved, syncing changes to Linear API") + (pearl-sync-org-to-linear))) + +(defun pearl--extract-org-heading-properties () + "Extract Linear issue properties from the org entry at point. +Returns a plist with :todo-state, :issue-id, :issue-identifier, and :team-id, +read from the entry's LINEAR-* property drawer via org APIs. Works from +anywhere inside the entry and at any heading depth, and reads by property name +rather than scanning lines, so body text or nested sub-entries don't confuse +it. Returns nil when point is not within a heading; the id fields are nil for +a non-issue heading. The team id is read directly from `LINEAR-TEAM-ID', so +there is no network lookup here." + (save-excursion + (when (ignore-errors (org-back-to-heading t) t) + (list :todo-state (org-get-todo-state) + :issue-id (org-entry-get nil "LINEAR-ID") + :issue-identifier (org-entry-get nil "LINEAR-IDENTIFIER") + :team-id (org-entry-get nil "LINEAR-TEAM-ID"))))) + + +(defun pearl--process-heading-at-point () + "Process the Linear issue at the current org heading." + (let* ((props (pearl--extract-org-heading-properties)) + (todo-state (plist-get props :todo-state)) + (issue-id (plist-get props :issue-id)) + (issue-identifier (plist-get props :issue-identifier)) + (team-id (plist-get props :team-id))) + + ;; Only sync when this heading is a Linear issue (has id, identifier, team). + (when (and issue-id issue-identifier team-id) + (let ((linear-state (pearl--map-org-state-to-linear todo-state))) + (when linear-state + (pearl--update-issue-state-async issue-id linear-state team-id)))))) + +(defun pearl-sync-org-to-linear () + "Syncs change from linear.org to Linear API." + (interactive) + ;; If called from org-after-todo-state-change-hook, just process the current heading + (if (eq this-command 'org-todo) + (pearl-sync-current-heading-to-linear) + ;; Otherwise, scan the entire file + (save-excursion + (goto-char (point-min)) + (let ((todo-states-pattern (pearl--get-todo-states-pattern))) + (while (re-search-forward (format "^\\*+ \\(%s\\)" todo-states-pattern) nil t) + ;; Process at the heading start, but keep the outer point at the end + ;; of this match so the next search advances past it. Without the + ;; save-excursion, `beginning-of-line' rewinds point and the search + ;; re-matches the same heading forever. + (save-excursion + (beginning-of-line) + (pearl--process-heading-at-point))))))) + +(defun pearl-sync-current-heading-to-linear () + "Sync the current org heading's TODO state to the Linear API. +Used when directly changing a TODO state in the org buffer." + (save-excursion + ;; Move up to the enclosing heading. `org-back-to-heading' signals + ;; "before first heading" in the preamble; guard so the sync entry point + ;; degrades to a no-op there instead of erroring. + (when (ignore-errors (org-back-to-heading t) t) + (pearl--process-heading-at-point)))) + +;;; Mapping Functions + +(defun pearl--map-linear-state-to-org (state) + "Map Linear STATE name to an Org TODO keyword string. +STATE is the Linear state string." + (or (cdr (assoc state pearl-state-to-todo-mapping)) + "TODO")) ; Default fallback + +(defun pearl--map-org-state-to-linear (todo-state) + "Map an Org TODO-STATE keyword to a Linear state name. +TODO-STATE is the Org keyword string." + (or (car (rassoc todo-state pearl-state-to-todo-mapping)) + nil)) + + +(defun pearl--get-todo-states-pattern () + "Return the regex pattern matching the Org TODO states. +Built from the org keywords in `pearl-state-to-todo-mapping' and +cached in `pearl-todo-states-pattern'. The cache is rebuilt when +the mapping changes, so a mid-session `setq' or customization takes effect." + (unless (and pearl-todo-states-pattern + (eq pearl--todo-states-pattern-source + pearl-state-to-todo-mapping)) + ;; Pattern like "TODO\\|IN-PROGRESS\\|IN-REVIEW\\|BACKLOG\\|BLOCKED\\|DONE". + (setq pearl--todo-states-pattern-source pearl-state-to-todo-mapping + pearl-todo-states-pattern + (mapconcat #'regexp-quote + (mapcar #'cdr pearl-state-to-todo-mapping) + "\\|"))) + pearl-todo-states-pattern) + +(defun pearl--map-linear-priority-to-org (priority-num) + "Convert Linear PRIORITY-NUM to an Org priority cookie. +PRIORITY-NUM is 0=None, 1=Urgent, 2=High, 3=Medium, 4=Low." + (cond + ((eq priority-num 1) "[#A]") ; Urgent -> A + ((eq priority-num 2) "[#B]") ; High -> B + ((eq priority-num 3) "[#C]") ; Medium -> C + ((eq priority-num 4) "[#D]") ; Low -> D + (t "[#C]"))) ; Default -> C + +(defun pearl--get-linear-priority-name (priority-num) + "Convert Linear PRIORITY-NUM to a readable name. +PRIORITY-NUM is 0=None, 1=Urgent, 2=High, 3=Medium, 4=Low." + (cond + ((eq priority-num 1) "Urgent") + ((eq priority-num 2) "High") + ((eq priority-num 3) "Medium") + ((eq priority-num 4) "Low") + (t "Medium"))) + +(defun pearl--md-line-to-org (line) + "Convert inline markdown in LINE to Org markup. +Handles links, inline code, bold, and underscore italics; other inline markup +passes through unchanged." + (let ((s line)) + ;; [text](url) -> [[url][text]] (before code/emphasis touch the brackets) + (setq s (replace-regexp-in-string + "\\[\\([^]]+\\)\\](\\([^) ]+\\))" "[[\\2][\\1]]" s)) + ;; `code` -> ~code~ + (setq s (replace-regexp-in-string "`\\([^`\n]+\\)`" "~\\1~" s)) + ;; **bold** -> *bold* + (setq s (replace-regexp-in-string "\\*\\*\\([^*\n]+?\\)\\*\\*" "*\\1*" s)) + ;; _italic_ -> /italic/, word-bounded so identifiers like foo_bar are left alone + (setq s (replace-regexp-in-string + "\\(^\\|[^[:alnum:]_]\\)_\\([^_\n]+?\\)_\\([^[:alnum:]_]\\|$\\)" + "\\1/\\2/\\3" s)) + s)) + +(defun pearl--md-to-org (md) + "Convert markdown MD to Org markup (the pure-elisp conversion tier). +Converts fenced code blocks to `#+begin_src'/`#+end_src', markdown headings to +bold lines (never Org headings), markdown bullets (`*' / `+') to `-', and the +inline markup in `pearl--md-line-to-org'. Any other line that would +read as an Org heading is space-guarded. Tables, HTML, and unrecognized +constructs pass through as literal text. Returns the empty string for an empty +MD." + (if (or (null md) (string-empty-p md)) + "" + (let ((in-code nil) (out '())) + (dolist (line (split-string md "\n")) + (cond + ;; fenced code fence: ``` or ```lang + ((string-match "\\`[ \t]*```\\(.*\\)\\'" line) + (if in-code + (progn (push "#+end_src" out) (setq in-code nil)) + (push (format "#+begin_src %s" (string-trim (match-string 1 line))) out) + (setq in-code t))) + (in-code (push line out)) + ;; markdown heading -> bold line, not an Org heading + ((string-match "\\`#+[ \t]+\\(.*\\)\\'" line) + (push (format "*%s*" (string-trim (match-string 1 line))) out)) + ;; markdown bullet -> Org dash bullet + ((string-match "\\`\\([ \t]*\\)[*+][ \t]+\\(.*\\)\\'" line) + (push (concat (match-string 1 line) "- " + (pearl--md-line-to-org (match-string 2 line))) + out)) + ;; guard any remaining line that Org would read as a heading + ((string-match "\\`\\*+ " line) + (push (concat " " (pearl--md-line-to-org line)) out)) + (t (push (pearl--md-line-to-org line) out)))) + (string-join (nreverse out) "\n")))) + +(defun pearl--org-line-to-md (line) + "Convert inline Org markup in LINE back to markdown. +The inverse of `pearl--md-line-to-org': org links, verbatim, bold, and +italics become their markdown forms. Other text passes through unchanged. +Italics are word-bounded so filesystem paths and URLs are left alone." + (let ((s line)) + ;; [[url][text]] -> [text](url) (before verbatim/emphasis touch brackets) + (setq s (replace-regexp-in-string + "\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" "[\\2](\\1)" s)) + ;; [[url]] -> url + (setq s (replace-regexp-in-string "\\[\\[\\([^]]+\\)\\]\\]" "\\1" s)) + ;; ~code~ -> `code` + (setq s (replace-regexp-in-string "~\\([^~\n]+\\)~" "`\\1`" s)) + ;; *bold* -> **bold** + (setq s (replace-regexp-in-string "\\*\\([^*\n]+?\\)\\*" "**\\1**" s)) + ;; /italic/ -> _italic_, word-bounded so /usr/local paths are left alone + (setq s (replace-regexp-in-string + "\\(^\\|[^[:alnum:]/]\\)/\\([^/\n]+?\\)/\\([^[:alnum:]/]\\|$\\)" + "\\1_\\2_\\3" s)) + s)) + +(defun pearl--org-to-md (org) + "Convert Org markup ORG back to markdown (the push direction). +The symmetric inverse of `pearl--md-to-org': `#+begin_src'/`#+end_src' +become fenced code (language preserved, contents verbatim), `#+begin_quote' +blocks become `>'-prefixed lines, Org checkbox marks normalize to markdown +lowercase, and the inline markup in `pearl--org-line-to-md' is undone. +Tables, HTML, and unrecognized lines pass through literally. Returns the +empty string for an empty ORG. + +Two constructs are intentionally lossy and do not round-trip back to their +markdown source: a markdown `# heading' (rendered to a bold line on fetch) +stays a bold line, and single-asterisk markdown italics are unsupported on +fetch. Both are documented in the conversion matrix." + (if (or (null org) (string-empty-p org)) + "" + (let ((in-code nil) (in-quote nil) (out '())) + (dolist (line (split-string org "\n")) + (cond + ;; src block open: #+begin_src or #+begin_src lang + ((string-match "\\`[ \t]*#\\+begin_src\\(.*\\)\\'" line) + (push (format "```%s" (string-trim (match-string 1 line))) out) + (setq in-code t)) + ((and in-code (string-match "\\`[ \t]*#\\+end_src[ \t]*\\'" line)) + (push "```" out) (setq in-code nil)) + (in-code (push line out)) + ;; quote block: drop the markers, prefix the contents with "> " + ((string-match "\\`[ \t]*#\\+begin_quote[ \t]*\\'" line) + (setq in-quote t)) + ((and in-quote (string-match "\\`[ \t]*#\\+end_quote[ \t]*\\'" line)) + (setq in-quote nil)) + (in-quote (push (concat "> " (pearl--org-line-to-md line)) out)) + ;; checkbox: normalize the uppercase Org mark to markdown lowercase + ((string-match "\\`\\([ \t]*\\)- \\[\\([ xX]\\)\\] \\(.*\\)\\'" line) + (push (concat (match-string 1 line) + "- [" (downcase (match-string 2 line)) "] " + (pearl--org-line-to-md (match-string 3 line))) + out)) + (t (push (pearl--org-line-to-md line) out)))) + (string-join (nreverse out) "\n")))) + +(defun pearl--format-comment (comment) + "Format a normalized COMMENT plist as a level-4 Org entry. +The heading carries the author and timestamp; a property drawer carries the +comment id, the author's user id (empty for bot/external comments, which are +not editable), and a sha256 of the last-fetched body for the sync conflict +gate. The body runs through the same markdown->org tier as the description. +A null author renders as `(unknown)'." + (let ((author (or (plist-get comment :author) "(unknown)")) + (created (or (plist-get comment :created-at) "")) + (raw-body (or (plist-get comment :body) "")) + (body (pearl--md-to-org (or (plist-get comment :body) "")))) + (concat (format "**** %s — %s\n" author created) + ":PROPERTIES:\n" + (format ":LINEAR-COMMENT-ID: %s\n" (or (plist-get comment :id) "")) + (format ":LINEAR-COMMENT-AUTHOR-ID: %s\n" (or (plist-get comment :author-id) "")) + (format ":LINEAR-COMMENT-SHA256: %s\n" (secure-hash 'sha256 raw-body)) + ":END:\n" + (if (string-empty-p body) "" (concat body "\n"))))) + +(defun pearl--format-comments (comments) + "Format COMMENTS (a list of normalized comment plists) as a Comments subtree. +Comments render oldest-first under a level-3 `Comments' heading. Returns the +empty string when COMMENTS is nil, so an issue with no comments renders no +subtree." + (if (null comments) + "" + (let ((sorted (sort (copy-sequence comments) + (lambda (a b) + (string< (or (plist-get a :created-at) "") + (or (plist-get b :created-at) "")))))) + (concat "*** Comments\n" + (mapconcat #'pearl--format-comment sorted ""))))) + +(defun pearl--format-issue-as-org-entry (issue) + "Format a normalized ISSUE plist as an Org entry. +The heading carries the title; structured fields live in a namespaced +`LINEAR-*' property drawer (changed via commands, not by hand); the issue +description renders as the entry body. `LINEAR-DESC-SHA256' (the markdown) and +`LINEAR-DESC-UPDATED-AT' record the description's provenance for the sync-back +conflict gates; `LINEAR-DESC-ORG-SHA256' hashes the rendered Org body so a +later refresh can tell a real local edit from a lossy md->org round-trip +without re-deriving the markdown. `LINEAR-TITLE-SHA256' is the title's hash +(over the rendered, bracket-stripped title)." + (let* ((title (or (plist-get issue :title) "")) + (description (or (plist-get issue :description) "")) + (state (plist-get issue :state)) + (team (plist-get issue :team)) + (project (plist-get issue :project)) + (assignee (plist-get issue :assignee)) + (todo (pearl--map-linear-state-to-org (plist-get state :name))) + (priority (pearl--map-linear-priority-to-org (plist-get issue :priority))) + (sanitized-title (replace-regexp-in-string "\\[\\|\\]" "" title)) + (label-names (mapconcat (lambda (l) (or (plist-get l :name) "")) + (plist-get issue :labels) ", ")) + (body-org (pearl--md-to-org description))) + (concat + (format "** %s %s %s\n" todo priority sanitized-title) + ":PROPERTIES:\n" + (format ":LINEAR-ID: %s\n" (or (plist-get issue :id) "")) + (format ":LINEAR-IDENTIFIER: %s\n" (or (plist-get issue :identifier) "")) + (format ":LINEAR-URL: %s\n" + (or (plist-get issue :url) + (format "https://linear.app/issue/%s" (or (plist-get issue :identifier) "")))) + (format ":LINEAR-TEAM-ID: %s\n" (or (plist-get team :id) "")) + (format ":LINEAR-TEAM-NAME: %s\n" (or (plist-get team :name) "")) + (format ":LINEAR-PROJECT-ID: %s\n" (or (plist-get project :id) "")) + (format ":LINEAR-PROJECT-NAME: %s\n" (or (plist-get project :name) "")) + (format ":LINEAR-STATE-ID: %s\n" (or (plist-get state :id) "")) + (format ":LINEAR-STATE-NAME: %s\n" (or (plist-get state :name) "")) + (format ":LINEAR-ASSIGNEE-ID: %s\n" (or (plist-get assignee :id) "")) + (format ":LINEAR-ASSIGNEE-NAME: %s\n" (or (plist-get assignee :name) "")) + (format ":LINEAR-LABELS: [%s]\n" label-names) + (format ":LINEAR-DESC-SHA256: %s\n" (secure-hash 'sha256 description)) + (format ":LINEAR-DESC-ORG-SHA256: %s\n" (secure-hash 'sha256 (string-trim body-org))) + (format ":LINEAR-DESC-UPDATED-AT: %s\n" (or (plist-get issue :updated-at) "")) + (format ":LINEAR-TITLE-SHA256: %s\n" (secure-hash 'sha256 sanitized-title)) + ":END:\n" + (if (string-empty-p body-org) "" (concat body-org "\n")) + (pearl--format-comments (plist-get issue :comments))))) + +;;; Description Sync-Back + +(defun pearl--sync-decision (local-md stored-hash remote-md) + "Decide how to sync a description edit. +LOCAL-MD is the current Org body rendered back to markdown. STORED-HASH is +the sha256 of the markdown recorded when the issue was last fetched. REMOTE-MD +is the description as it stands on Linear right now. Returns: + +- `:noop' -- nothing to push (no local edit, or local already matches + remote), +- `:push' -- a local edit against an unchanged remote: safe to push, +- `:conflict' -- both sides changed since the last fetch." + (let ((local-hash (secure-hash 'sha256 (or local-md ""))) + (remote-hash (secure-hash 'sha256 (or remote-md "")))) + (cond + ((string= local-hash stored-hash) :noop) + ((string= local-hash remote-hash) :noop) + ((string= remote-hash stored-hash) :push) + (t :conflict)))) + +;;; Conflict Resolution + +;; When a description, title, or comment changed both locally and on Linear +;; since the last fetch, `pearl--sync-decision' returns `:conflict'. Instead of +;; only refusing, the sync commands offer use-local / use-remote / rewrite (and +;; cancel). The hard rule: no resolution silently discards the local edit, so +;; any destructive choice stashes it first (see `pearl--stash-conflict-text'). + +(defconst pearl--conflict-backup-buffer "*pearl-conflict-backup*" + "Buffer holding stashed local text from destructive conflict resolutions.") + +(defun pearl--stash-conflict-text (label text) + "Stash TEXT so a destructive conflict resolution can't lose it. +Pushes TEXT onto the `kill-ring' (recover with `yank') and appends it to the +`pearl--conflict-backup-buffer' under a heading naming LABEL and the time. +Called before \"use remote\" or a rewrite replaces the local edit. Empty TEXT +is a no-op -- there is nothing to lose." + (when (and text (not (string-empty-p text))) + (kill-new text) + (with-current-buffer (get-buffer-create pearl--conflict-backup-buffer) + (goto-char (point-max)) + (unless (bobp) (insert "\n")) + (insert (format "## %s -- %s\n" label + (format-time-string "%Y-%m-%d %H:%M:%S"))) + (insert text) + (unless (string-suffix-p "\n" text) (insert "\n"))))) + +(defun pearl--conflict-smerge-string (local remote) + "Return a git-style merge-conflict string with LOCAL and REMOTE sections. +LOCAL is the user's current text, REMOTE is Linear's. Each section is newline +terminated so the markers always start their own line; the result is meant to +drop into `smerge-mode' for resolution." + (concat "<<<<<<< LOCAL (your edit)\n" + local (unless (string-suffix-p "\n" local) "\n") + "=======\n" + remote (unless (string-suffix-p "\n" remote) "\n") + ">>>>>>> REMOTE (Linear)\n")) + +(defun pearl--read-conflict-resolution (label) + "Prompt for how to resolve the conflict on LABEL, returning a symbol. +One of `use-local' (push mine, overwrite Linear), `use-remote' (take Linear's, +stash mine), `rewrite' (merge both in a buffer), or `cancel'. A bare RET +defaults to `cancel', leaving everything untouched." + (let* ((choices '(("cancel -- leave both untouched" . cancel) + ("use local -- push my version, overwrite Linear" . use-local) + ("use remote -- take Linear's, stash mine" . use-remote) + ("rewrite -- merge both in a buffer" . rewrite))) + (default (caar choices)) + (pick (completing-read + (format "Conflict on %s (RET cancels): " label) + (mapcar #'car choices) nil t nil nil default))) + (cdr (assoc pick choices)))) + +(defun pearl--set-entry-body-at-point (org-text) + "Replace the body of the org entry at point with ORG-TEXT. +The body is the region after the entry's drawers and before its first child +heading, so a Comments subtree is left intact. ORG-TEXT is org markup (already +converted from markdown); an empty string clears the body. Used to write a +resolved description or comment back into the buffer." + (save-excursion + (org-back-to-heading t) + (org-end-of-meta-data t) + (let ((beg (point)) + (end (save-excursion (outline-next-heading) (point)))) + (delete-region beg end) + (goto-char beg) + (unless (string-empty-p org-text) + (insert org-text "\n"))))) + +(defun pearl--resolve-conflict (label local-md remote-md marker stored-prop apply-fn push-fn) + "Interactively resolve a sync conflict on LABEL. +LOCAL-MD and REMOTE-MD are the two diverged versions. MARKER anchors the org +entry; STORED-PROP is the provenance property advanced on resolution (such as +\"LINEAR-DESC-SHA256\"). APPLY-FN takes a text string and writes it into the +buffer (re-rendering the body, title, or comment); PUSH-FN takes a text string +and a callback invoked with non-nil on a successful push. + +Resolutions (see `pearl--read-conflict-resolution'): `cancel' leaves both +untouched; `use-local' pushes the local text and advances the hash on success; +`use-remote' stashes the local text, writes Linear's version in, and advances +the hash with no push (the remote is already current). `rewrite' is the +deferred smerge flow -- for now it stashes the local text and redirects, so +nothing is lost." + (pcase (pearl--read-conflict-resolution label) + ('cancel + (message "Left %s untouched (refresh to see Linear's version)" label)) + ('use-local + (funcall push-fn local-md + (lambda (ok) + (if ok + (progn + (org-entry-put marker stored-prop + (secure-hash 'sha256 local-md)) + (message "Pushed your %s to Linear" label)) + (message "Failed to push %s" label))))) + ('use-remote + (pearl--stash-conflict-text label local-md) + (funcall apply-fn remote-md) + (org-entry-put marker stored-prop (secure-hash 'sha256 remote-md)) + (message "Took Linear's %s; your version is on the kill ring and in %s" + label pearl--conflict-backup-buffer)) + ('rewrite + (pearl--stash-conflict-text label local-md) + (pearl--resolve-conflict-in-smerge + label local-md remote-md + (lambda (reconciled) + (funcall apply-fn reconciled) + (funcall push-fn reconciled + (lambda (ok) + (if ok + (progn + (org-entry-put marker stored-prop + (secure-hash 'sha256 reconciled)) + (message "Synced merged %s to Linear" label)) + (message "Failed to push merged %s" label))))))))) + +(defvar-local pearl--conflict-on-finish nil + "Callback invoked with the reconciled text when a conflict buffer commits.") + +(defun pearl--conflict-has-markers-p (text) + "Return non-nil if any git-style conflict markers remain in TEXT. +Used to refuse a commit while the user has left a section unresolved." + (and (string-match-p "^\\(<<<<<<<\\|=======\\|>>>>>>>\\)" text) t)) + +(defun pearl--resolve-conflict-in-smerge (label local remote on-finish) + "Open an smerge buffer to reconcile LOCAL vs REMOTE for LABEL. +The user resolves the conflict markers with the usual `smerge-mode' commands, +then \\[pearl--conflict-commit] hands the reconciled text to ON-FINISH and kills +the buffer, while \\[pearl--conflict-abort] cancels (the local text is already +stashed). ON-FINISH runs only when no conflict markers remain." + (require 'smerge-mode) + (let ((buf (get-buffer-create (format "*pearl-merge: %s*" label)))) + (with-current-buffer buf + (erase-buffer) + (insert (pearl--conflict-smerge-string local remote)) + (goto-char (point-min)) + (smerge-mode 1) + (setq-local pearl--conflict-on-finish on-finish) + (local-set-key (kbd "C-c C-c") #'pearl--conflict-commit) + (local-set-key (kbd "C-c C-k") #'pearl--conflict-abort) + (setq-local header-line-format + (substitute-command-keys + "Resolve the conflict, then \\[pearl--conflict-commit] to push, \\[pearl--conflict-abort] to abort"))) + (pop-to-buffer buf))) + +(defun pearl--conflict-commit () + "Finish the current pearl conflict buffer, pushing the reconciled text. +Refuses while conflict markers remain; otherwise hands the buffer text to the +armed ON-FINISH callback and kills the buffer." + (interactive) + (let ((text (buffer-string))) + (when (pearl--conflict-has-markers-p text) + (user-error "Unresolved conflict markers remain; resolve them or abort with C-c C-k")) + (let ((cb pearl--conflict-on-finish)) + (kill-buffer (current-buffer)) + (when cb (funcall cb text))))) + +(defun pearl--conflict-abort () + "Abort the current pearl conflict buffer without pushing. +The local text was stashed before the buffer opened, so nothing is lost." + (interactive) + (kill-buffer (current-buffer)) + (message "Conflict resolution aborted; your text is on the kill ring and in %s" + pearl--conflict-backup-buffer)) + +(defun pearl--issue-body-at-point () + "Return the description body of the Linear issue subtree at point. +The body is the text after the property drawer and before the first child +heading (so a Comments subtree is excluded), trimmed of surrounding +whitespace. Returns the empty string when the entry has no body." + (save-excursion + (org-back-to-heading t) + ;; Fix the body's end (the next heading: a Comments child or the next + ;; issue) from the heading itself, before `org-end-of-meta-data' moves + ;; point. For an empty body that call skips blank lines and lands on the + ;; next heading, so without this clamp the body would overshoot into the + ;; next issue's whole subtree. + (let ((end (save-excursion (outline-next-heading) (point)))) + (org-end-of-meta-data t) + (if (>= (point) end) + "" + (string-trim (buffer-substring-no-properties (point) end)))))) + +(defun pearl--fetch-issue-description-async (issue-id callback) + "Fetch ISSUE-ID's current description and timestamp from Linear. +CALLBACK is called with a plist (:description STR :updated-at STR) on success, +or nil on error." + (let ((query "query IssueDescription($id: String!) { + issue(id: $id) { + description + updatedAt + } + }") + (variables `(("id" . ,issue-id)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let ((issue (cdr (assoc 'issue (assoc 'data data))))) + (funcall callback + (when issue + (list :description (or (cdr (assoc 'description issue)) "") + :updated-at (cdr (assoc 'updatedAt issue))))))) + (lambda (_error _response _data) (funcall callback nil))))) + +(defun pearl--update-issue-description-async (issue-id markdown callback) + "Push MARKDOWN as ISSUE-ID's description via issueUpdate. +CALLBACK is called with a plist (:success BOOL :updated-at STR)." + (let ((query "mutation UpdateIssueDescription($id: String!, $description: String!) { + issueUpdate(id: $id, input: {description: $description}) { + success + issue { + id + updatedAt + } + } + }") + (variables `(("id" . ,issue-id) ("description" . ,markdown)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let* ((payload (cdr (assoc 'issueUpdate (assoc 'data data)))) + (success (eq t (cdr (assoc 'success payload)))) + (issue (cdr (assoc 'issue payload)))) + (funcall callback + (list :success success + :updated-at (cdr (assoc 'updatedAt issue)))))) + (lambda (_error _response _data) (funcall callback '(:success nil)))))) + +(defun pearl--fetch-issue-title-async (issue-id callback) + "Fetch ISSUE-ID's current title and timestamp from Linear. +CALLBACK is called with a plist (:title STR :updated-at STR) on success, or nil +on error." + (let ((query "query IssueTitle($id: String!) { + issue(id: $id) { + title + updatedAt + } + }") + (variables `(("id" . ,issue-id)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let ((issue (cdr (assoc 'issue (assoc 'data data))))) + (funcall callback + (when issue + (list :title (or (cdr (assoc 'title issue)) "") + :updated-at (cdr (assoc 'updatedAt issue))))))) + (lambda (_error _response _data) (funcall callback nil))))) + +(defun pearl--update-issue-title-async (issue-id title callback) + "Push TITLE as ISSUE-ID's title via issueUpdate. +CALLBACK is called with a plist (:success BOOL :updated-at STR)." + (let ((query "mutation UpdateIssueTitle($id: String!, $title: String!) { + issueUpdate(id: $id, input: {title: $title}) { + success + issue { + id + updatedAt + } + } + }") + (variables `(("id" . ,issue-id) ("title" . ,title)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let* ((payload (cdr (assoc 'issueUpdate (assoc 'data data)))) + (success (eq t (cdr (assoc 'success payload)))) + (issue (cdr (assoc 'issue payload)))) + (funcall callback + (list :success success + :updated-at (cdr (assoc 'updatedAt issue)))))) + (lambda (_error _response _data) (funcall callback '(:success nil)))))) + +(defun pearl--issue-title-at-point () + "Return the title of the Linear issue heading at point. +Strips the TODO keyword, priority cookie, and tags, leaving the bare title +text (which is the bracket-stripped form the renderer wrote)." + (save-excursion + (org-back-to-heading t) + (org-get-heading t t t t))) + +;;;###autoload +(defun pearl-sync-current-issue () + "Push the description edited in the Org body of the issue at point to Linear. +Works from anywhere inside an issue subtree. The push is gated: if the body +is unchanged since the last fetch nothing is sent; if it was edited and the +remote is unchanged the edit is pushed and the provenance properties advance; +if both the body and the remote changed since the last fetch the push is +refused and the conflict reported (refresh to reconcile)." + (interactive) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (stored (org-entry-get nil "LINEAR-DESC-SHA256")) + (marker (point-marker))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (let* ((local-md (pearl--org-to-md (pearl--issue-body-at-point)))) + (if (string= (secure-hash 'sha256 local-md) (or stored "")) + (message "No description changes to sync for %s" issue-id) + (pearl--progress "Checking Linear for remote changes...") + (pearl--fetch-issue-description-async + issue-id + (lambda (remote) + (if (null remote) + (message "Could not fetch %s from Linear; not syncing" issue-id) + (pcase (pearl--sync-decision + local-md stored (plist-get remote :description)) + (:noop (message "%s already matches Linear" issue-id)) + (:conflict + (pearl--resolve-conflict + (format "%s description" issue-id) + local-md (plist-get remote :description) + marker "LINEAR-DESC-SHA256" + (lambda (md) + (org-with-point-at marker + (pearl--set-entry-body-at-point (pearl--md-to-org md)))) + (lambda (md cb) + (pearl--update-issue-description-async + issue-id md + (lambda (r) (funcall cb (plist-get r :success))))))) + (:push + (pearl--update-issue-description-async + issue-id local-md + (lambda (result) + (if (plist-get result :success) + (progn + (org-entry-put marker "LINEAR-DESC-SHA256" + (secure-hash 'sha256 local-md)) + (when (plist-get result :updated-at) + (org-entry-put marker "LINEAR-DESC-UPDATED-AT" + (plist-get result :updated-at))) + (message "Synced description for %s to Linear" issue-id) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to sync description for %s" issue-id)))))))))))))) + +;;;###autoload +(defun pearl-sync-current-issue-title () + "Push the title edited in the heading of the issue at point to Linear. +A separate path from the description sync, sharing the same conflict gate and +working from anywhere inside an issue subtree. Note the title is lossy: the +renderer strips square brackets, so the heading holds the stripped form and a +push sends that stripped title. Gated like the description sync: unchanged +title sends nothing; a local edit against an unchanged remote pushes and +advances the title provenance; both-changed refuses and reports the conflict." + (interactive) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (stored (org-entry-get nil "LINEAR-TITLE-SHA256")) + (marker (point-marker))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (let ((local-title (pearl--issue-title-at-point))) + (if (string= (secure-hash 'sha256 local-title) (or stored "")) + (message "No title changes to sync for %s" issue-id) + (pearl--progress "Checking Linear for remote title changes...") + (pearl--fetch-issue-title-async + issue-id + (lambda (remote) + (if (null remote) + (message "Could not fetch %s from Linear; not syncing" issue-id) + (pcase (pearl--sync-decision + local-title stored (plist-get remote :title)) + (:noop (message "%s title already matches Linear" issue-id)) + (:conflict + (pearl--resolve-conflict + (format "%s title" issue-id) + local-title (plist-get remote :title) + marker "LINEAR-TITLE-SHA256" + (lambda (md) + (org-with-point-at marker + (org-back-to-heading t) + (org-edit-headline md))) + (lambda (md cb) + (pearl--update-issue-title-async + issue-id md + (lambda (r) (funcall cb (plist-get r :success))))))) + (:push + (pearl--update-issue-title-async + issue-id local-title + (lambda (result) + (if (plist-get result :success) + (progn + (org-entry-put marker "LINEAR-TITLE-SHA256" + (secure-hash 'sha256 local-title)) + (message "Synced title for %s to Linear" issue-id) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to sync title for %s" issue-id)))))))))))))) + +(defun pearl--replace-issue-subtree-at-point (issue) + "Replace the issue subtree at point with a freshly formatted ISSUE entry. +ISSUE is a normalized issue plist. The whole subtree (heading, drawer, body, +and any comment children) is rewritten from the entry, so the rendered result +matches a first fetch." + (save-excursion + (org-back-to-heading t) + (let ((beg (point)) + (end (save-excursion (org-end-of-subtree t t) (point)))) + (delete-region beg end) + (goto-char beg) + (insert (pearl--format-issue-as-org-entry issue)) + ;; Close the rewritten subtree's drawer(s) but leave the issue itself + ;; expanded -- a single-issue refresh keeps the user on the issue they + ;; were looking at, unlike a full repopulation which re-folds the page. + (when pearl-fold-after-update + (save-excursion + (goto-char beg) + (save-restriction + (org-narrow-to-subtree) + (pearl--hide-all-drawers))))))) + +;;;###autoload +(defun pearl-refresh-current-issue () + "Re-fetch the issue at point from Linear and rewrite its subtree in place. +Works from anywhere inside an issue subtree. If the description body has +unpushed local edits, they are stashed first (kill ring + the conflict-backup +buffer) so the refresh can't silently lose them (decision 4), then the refresh +proceeds and the subtree is replaced with Linear's version." + (interactive) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (stored (org-entry-get nil "LINEAR-DESC-SHA256")) + (marker (point-marker))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (let ((local-md (pearl--org-to-md (pearl--issue-body-at-point)))) + ;; Stash an unpushed edit before the overwrite rather than refusing, + ;; so an explicit single-issue refresh always proceeds without data loss. + (unless (string= (secure-hash 'sha256 local-md) (or stored "")) + (pearl--stash-conflict-text + (format "%s description (pre-refresh)" issue-id) local-md)) + (pearl--progress "Refreshing %s from Linear..." issue-id) + (pearl--fetch-issue-async + issue-id + (lambda (result) + (pcase result + ((or :error (pred null)) + (message "Linear returned an error fetching %s; not refreshing" issue-id)) + (:missing + (message "Issue %s is no longer on Linear (deleted or no access); not refreshing" + issue-id)) + (raw + (save-excursion + (goto-char marker) + (pearl--replace-issue-subtree-at-point + (pearl--normalize-issue raw))) + (pearl-highlight-comments) + (pearl--surface-buffer (marker-buffer marker)) + (message "Refreshed %s from Linear" issue-id))))))))) + +(defun pearl--create-comment-async (issue-id body callback) + "Create a comment with BODY on ISSUE-ID via commentCreate. +CALLBACK is called with the normalized comment plist on success, or nil on a +GraphQL/transport failure or a non-success payload." + (let ((query "mutation CommentCreate($issueId: String!, $body: String!) { + commentCreate(input: {issueId: $issueId, body: $body}) { + success + comment { + id body createdAt + user { id name displayName } + botActor { name } + externalUser { name } + } + } + }") + (variables `(("issueId" . ,issue-id) ("body" . ,body)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let* ((payload (cdr (assoc 'commentCreate (assoc 'data data)))) + (success (eq t (cdr (assoc 'success payload)))) + (comment (cdr (assoc 'comment payload)))) + (funcall callback + (and success comment (pearl--normalize-comment comment))))) + (lambda (_error _response _data) (funcall callback nil))))) + +(defun pearl--append-comment-to-issue (comment) + "Insert COMMENT (a normalized plist) under the issue subtree at point. +Appends after any existing comments in the issue's `Comments' subtree, creating +that subtree at the end of the issue when it does not exist yet." + (save-excursion + (org-back-to-heading t) + (let* ((issue-end (save-excursion (org-end-of-subtree t t) (point))) + (comments-pos + (save-excursion + (when (re-search-forward "^\\*+ Comments[ \t]*$" issue-end t) + (match-beginning 0))))) + (if comments-pos + (progn + (goto-char comments-pos) + (org-end-of-subtree t t) + (insert (pearl--format-comment comment))) + (goto-char issue-end) + (insert "*** Comments\n" (pearl--format-comment comment)))))) + +;;;###autoload +(defun pearl-add-comment (body) + "Add a comment with BODY to the Linear issue at point and insert it. +Works from anywhere inside an issue subtree. The new comment is the viewer's +own, so it renders editable; edit it later with +`pearl-edit-current-comment'." + (interactive "sComment: ") + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (marker (point-marker))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (pearl--progress "Adding comment to %s..." issue-id) + (pearl--create-comment-async + issue-id body + (lambda (comment) + (if (null comment) + (message "Failed to add comment to %s" issue-id) + (save-excursion + (goto-char marker) + (pearl--append-comment-to-issue comment)) + (pearl-highlight-comments) + (pearl--surface-buffer (marker-buffer marker)) + (message "Added comment to %s" issue-id))))))) + +;;;###autoload +(defun pearl-open-current-issue () + "Open the Linear issue at point in the browser. +Reads the `LINEAR-URL' property of the enclosing issue heading and hands it to +`browse-url'. Works from anywhere inside the issue subtree." + (interactive) + (let ((url (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (org-entry-get nil "LINEAR-URL")))) + (unless (and url (not (string-empty-p url))) + (user-error "No LINEAR-URL on the issue at point")) + (browse-url url))) + +(defun pearl--delete-issue-async (issue-id callback) + "Delete ISSUE-ID on Linear via issueDelete, calling CALLBACK with the outcome. +CALLBACK receives a plist (:success BOOL). Linear's `issueDelete' is a soft +delete: it moves the issue to Trash (recoverable for about 30 days), not a +permanent purge." + (let ((query "mutation IssueDelete($id: String!) { + issueDelete(id: $id) { success } + }") + (variables `(("id" . ,issue-id)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let ((payload (cdr (assoc 'issueDelete (assoc 'data data))))) + (funcall callback + (list :success (eq t (cdr (assoc 'success payload))))))) + (lambda (_error _response _data) (funcall callback '(:success nil)))))) + +;;;###autoload +(defun pearl-delete-current-issue () + "Delete the Linear issue at point after confirmation, removing its subtree. +Works from anywhere inside an issue subtree. Confirms first, then issues a +soft delete (Linear moves the issue to Trash, recoverable for about 30 days); +on success the issue's Org subtree is removed from the buffer." + (interactive) + (unless (save-excursion (ignore-errors (org-back-to-heading t) t)) + (user-error "Not on a Linear issue heading")) + (let* ((marker (save-excursion (org-back-to-heading t) (point-marker))) + (issue-id (org-entry-get marker "LINEAR-ID")) + (ident (or (org-entry-get marker "LINEAR-IDENTIFIER") "this issue"))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (when (yes-or-no-p (format "Delete %s from Linear (moves it to Trash)? " ident)) + (pearl--delete-issue-async + issue-id + (lambda (result) + (if (plist-get result :success) + (progn + (save-excursion + (goto-char marker) + (org-back-to-heading t) + (delete-region (point) + (progn (org-end-of-subtree t t) (point)))) + (message "Deleted %s (moved to Trash on Linear)" ident) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to delete %s" ident))))))) + +;;; Command-managed Drawer Fields + +(defun pearl--update-issue-async (issue-id input callback) + "Push INPUT (an `IssueUpdateInput' alist) to ISSUE-ID via issueUpdate. +INPUT is an alist of field names to values, such as a single +\"priority\"/2 or \"stateId\"/id pair, json-encoded into the input object. +CALLBACK is called with a plist of :success BOOL and :updated-at STR. This is +the generic mutation the field commands share." + (let ((query "mutation UpdateIssue($id: String!, $input: IssueUpdateInput!) { + issueUpdate(id: $id, input: $input) { + success + issue { id updatedAt } + } + }") + (variables `(("id" . ,issue-id) ("input" . ,input)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let* ((payload (cdr (assoc 'issueUpdate (assoc 'data data)))) + (success (eq t (cdr (assoc 'success payload)))) + (issue (cdr (assoc 'issue payload)))) + (funcall callback + (list :success success + :updated-at (cdr (assoc 'updatedAt issue)))))) + (lambda (_error _response _data) (funcall callback '(:success nil)))))) + +(defconst pearl--priority-choices + '(("None" . 0) ("Urgent" . 1) ("High" . 2) ("Medium" . 3) ("Low" . 4)) + "Linear priority names mapped to their numeric API values.") + +(defun pearl--set-priority-cookie (priority-num) + "Set the Org priority cookie on the heading at point from PRIORITY-NUM. +1-4 map to #A-#D; 0 (None) removes the cookie. The priority range is bound +locally so #D is accepted regardless of the user's `org-priority' settings." + (save-excursion + (org-back-to-heading t) + (let ((org-priority-highest ?A) + (org-priority-lowest ?D)) + (pcase priority-num + (1 (org-priority ?A)) + (2 (org-priority ?B)) + (3 (org-priority ?C)) + (4 (org-priority ?D)) + (_ (org-priority 'remove)))))) + +;;;###autoload +(defun pearl-set-priority (priority-name) + "Set the priority of the Linear issue at point to PRIORITY-NAME. +Interactively, completes over None/Urgent/High/Medium/Low. Pushes the numeric +priority to Linear and rewrites the heading cookie on success. Works from +anywhere inside an issue subtree." + (interactive + (list (completing-read "Priority: " pearl--priority-choices nil t))) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (priority-num (cdr (assoc priority-name pearl--priority-choices))) + (marker (point-marker))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (unless priority-num + (user-error "Unknown priority: %s" priority-name)) + (pearl--update-issue-async + issue-id `(("priority" . ,priority-num)) + (lambda (result) + (if (plist-get result :success) + (progn + (save-excursion + (goto-char marker) + (pearl--set-priority-cookie priority-num)) + (message "Set %s priority to %s" issue-id priority-name) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to set priority for %s" issue-id))))))) + +(defun pearl--set-heading-state (state-name state-id) + "Update the heading at point to STATE-NAME / STATE-ID. +Rewrites the TODO keyword (mapped from STATE-NAME) and the LINEAR-STATE-NAME / +LINEAR-STATE-ID drawer properties. The Linear org-todo sync hook is inhibited +during the keyword change so updating the keyword here does not trigger a +second push back to Linear." + (save-excursion + (org-back-to-heading t) + (org-entry-put nil "LINEAR-STATE-NAME" state-name) + (org-entry-put nil "LINEAR-STATE-ID" state-id) + (let ((org-after-todo-state-change-hook nil)) + (org-todo (pearl--map-linear-state-to-org state-name))))) + +;;;###autoload +(defun pearl-set-state (state-name) + "Set the workflow state of the Linear issue at point to STATE-NAME. +Interactively, completes over the issue team's workflow states. Pushes the +resolved state id to Linear and updates the heading keyword and drawer on +success. Works from anywhere inside an issue subtree." + (interactive + (let ((team-id (save-excursion + (when (ignore-errors (org-back-to-heading t) t) + (org-entry-get nil "LINEAR-TEAM-ID"))))) + (list (completing-read + "State: " + (mapcar (lambda (s) (cdr (assoc 'name s))) + (and team-id (pearl--team-states team-id))) + nil t)))) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let* ((issue-id (org-entry-get nil "LINEAR-ID")) + (team-id (org-entry-get nil "LINEAR-TEAM-ID")) + (marker (point-marker)) + (states (and team-id (pearl--team-states team-id))) + (state (seq-find (lambda (s) (string= (cdr (assoc 'name s)) state-name)) + states)) + (state-id (and state (cdr (assoc 'id state))))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (unless state-id + (user-error "No workflow state named %s in this team" state-name)) + (pearl--update-issue-async + issue-id `(("stateId" . ,state-id)) + (lambda (result) + (if (plist-get result :success) + (progn + (save-excursion + (goto-char marker) + (pearl--set-heading-state state-name state-id)) + (message "Set %s state to %s" issue-id state-name) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to set state for %s" issue-id))))))) + +(defun pearl--team-collection-names (kind team-id) + "Return the display labels of the KIND collection for TEAM-ID, for completion." + (mapcar (lambda (n) (pearl--node-label kind n)) + (and team-id (pearl--team-collection kind team-id)))) + +;;;###autoload +(defun pearl-set-assignee (assignee-name) + "Set the assignee of the Linear issue at point to ASSIGNEE-NAME. +Interactively, completes over the issue team's members. Resolves the name to +a user id, pushes it, and updates the assignee drawer on success. Works from +anywhere inside an issue subtree." + (interactive + (let ((team-id (save-excursion + (when (ignore-errors (org-back-to-heading t) t) + (org-entry-get nil "LINEAR-TEAM-ID"))))) + (list (completing-read "Assignee: " + (pearl--team-collection-names 'members team-id) + nil t)))) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let* ((issue-id (org-entry-get nil "LINEAR-ID")) + (team-id (org-entry-get nil "LINEAR-TEAM-ID")) + (marker (point-marker)) + (assignee-id (and team-id + (pearl--resolve-team-id 'members assignee-name team-id)))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (unless assignee-id + (user-error "No team member matching %s" assignee-name)) + (pearl--update-issue-async + issue-id `(("assigneeId" . ,assignee-id)) + (lambda (result) + (if (plist-get result :success) + (progn + (save-excursion + (goto-char marker) + (org-entry-put nil "LINEAR-ASSIGNEE-NAME" assignee-name) + (org-entry-put nil "LINEAR-ASSIGNEE-ID" assignee-id)) + (message "Set %s assignee to %s" issue-id assignee-name) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to set assignee for %s" issue-id))))))) + +;;;###autoload +(defun pearl-set-labels (label-names) + "Set the labels of the Linear issue at point to LABEL-NAMES. +Interactively, completes (multiple) over the issue team's labels; an empty +selection clears the labels. Resolves each name to a label id, pushes the id +list, and updates the labels drawer on success. Works from anywhere inside an +issue subtree." + (interactive + (let ((team-id (save-excursion + (when (ignore-errors (org-back-to-heading t) t) + (org-entry-get nil "LINEAR-TEAM-ID"))))) + (list (completing-read-multiple + "Labels (comma-separated, empty to clear): " + (pearl--team-collection-names 'labels team-id))))) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let* ((issue-id (org-entry-get nil "LINEAR-ID")) + (team-id (org-entry-get nil "LINEAR-TEAM-ID")) + (marker (point-marker)) + (label-ids (mapcar + (lambda (name) + (or (and team-id + (pearl--resolve-team-id 'labels name team-id)) + (user-error "No label matching %s" name))) + label-names))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (pearl--update-issue-async + issue-id `(("labelIds" . ,label-ids)) + (lambda (result) + (if (plist-get result :success) + (progn + (save-excursion + (goto-char marker) + (org-entry-put nil "LINEAR-LABELS" + (format "[%s]" (mapconcat #'identity label-names ", ")))) + (message "Set %s labels to %s" issue-id + (if label-names (mapconcat #'identity label-names ", ") "none")) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to set labels for %s" issue-id))))))) + +;;; User-facing Commands (Async) + +(defun pearl--source-name (source) + "Return the display name of a SOURCE descriptor, or a default." + (or (plist-get source :name) "Linear issues")) + +(defun pearl--summarize-filter (filter) + "Return a short human-readable summary of a FILTER authoring plist. +An empty FILTER summarizes as \"all issues\"." + (if (null filter) + "all issues" + (let (parts) + (cl-loop for (key val) on filter by #'cddr do + (push (pcase key + (:assignee (format "assignee: %s" + (if (eq val :me) "me" val))) + (:open (if val "open" "any state")) + (:labels (format "labels: %s" + (mapconcat #'identity + (if (listp val) val (list val)) + ", "))) + (_ (format "%s: %s" (substring (symbol-name key) 1) val))) + parts)) + (mapconcat #'identity (nreverse parts) ", ")))) + +(defun pearl--read-active-source () + "Read the active source descriptor from the current buffer's header, or nil. +Parses the `#+LINEAR-SOURCE:' keyword that `pearl--build-org-content' +writes." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^#\\+LINEAR-SOURCE: \\(.*\\)$" nil t) + (ignore-errors (car (read-from-string (match-string 1))))))) + +(defun pearl--build-org-content (issues &optional source truncated) + "Build the Org content string for the linear org file from ISSUES. +SOURCE is the active-source descriptor recorded in the header so a later +`pearl-refresh-current-view' can re-run it; TRUNCATED marks that the +page cap was hit. Pure function, no side effects." + (let* ((src (or source '(:type filter :name "Linear issues" :filter nil))) + (name (pearl--source-name src)) + (filter (plist-get src :filter))) + (with-temp-buffer + (insert (format "#+title: Linear — %s\n" name)) + (insert "#+STARTUP: show3levels\n") + (insert (format "#+TODO: %s\n" + (if (bound-and-true-p org-todo-keywords) + (let ((seq (car org-todo-keywords))) + (mapconcat #'identity (cdr seq) " ")) + "TODO IN-PROGRESS IN-REVIEW BACKLOG BLOCKED | DONE"))) + ;; Source-tracking metadata: the serialized source drives refresh; the + ;; rest is human-readable provenance. + (insert (format "#+LINEAR-SOURCE: %s\n" (prin1-to-string src))) + (insert (format "#+LINEAR-RUN-AT: %s\n" (format-time-string "%Y-%m-%d %H:%M"))) + (insert (format "#+LINEAR-FILTER: %s\n" (pearl--summarize-filter filter))) + (insert (format "#+LINEAR-COUNT: %d\n" (length issues))) + (insert (format "#+LINEAR-TRUNCATED: %s\n" (if truncated "yes" "no"))) + ;; Affordance preamble (org comments -- not rendered content). + (insert "#\n") + (insert "# Body = the issue description; edit it, then M-x pearl-sync-current-issue to push.\n") + (insert "# Comments subtree = the thread; add with M-x pearl-add-comment.\n") + (insert "# Drawer fields change via M-x pearl-set-priority / -state / -assignee / -labels.\n") + (insert "# Refresh with M-x pearl-refresh-current-view (whole file) or -current-issue (one).\n") + (insert "\n") + + ;; Single top-level parent so the issues are sortable as a group + ;; (org-sort on this heading) instead of orphan headings, and so a + ;; show3levels fold has a level-1 root. Named after the view. + (insert (format "* %s\n" name)) + + (dolist (issue issues) + (insert (pearl--format-issue-as-org-entry issue))) + + (buffer-string)))) + +(defun pearl--update-org-from-issues (issues &optional source truncated) + "Update `pearl-org-file-path' with rendered ISSUES, buffer-aware. +SOURCE and TRUNCATED are threaded into the header (see +`pearl--build-org-content'). + +Behavior depends on whether the file is currently visited in a buffer: + +- No buffer visiting the file: write atomically to disk via `with-temp-file', + then visit it so there is a buffer to show. +- Buffer exists and is unmodified: replace its contents in place and save, + preserving point and avoiding a modtime mismatch warning. +- Buffer exists and has unsaved edits: do not overwrite. Log and emit a + message asking the user to save or revert before re-running. + +In every case the resulting buffer is surfaced (see `pearl--surface-buffer'), +so a fetch run from a menu or dashboard actually shows the issues instead of +just writing the file and leaving it off-screen." + (let* ((org-file-path pearl-org-file-path) + (new-content (pearl--build-org-content issues source truncated)) + (existing-buf (find-buffer-visiting org-file-path))) + (cond + ;; Branch A: no buffer visits the file -- atomic file write, then visit. + ((not existing-buf) + (pearl--log "Writing %d issues to %s (no buffer)" + (length issues) org-file-path) + (make-directory (file-name-directory org-file-path) t) + (with-temp-file org-file-path + (insert new-content)) + (message "Updated Linear issues in %s with %d active issues" + org-file-path (length issues)) + (let ((buf (find-file-noselect org-file-path))) + (with-current-buffer buf (pearl--restore-page-visibility)) + (pearl--surface-buffer buf))) + + ;; Branch B: buffer exists and is clean -- replace contents in place. + ((not (buffer-modified-p existing-buf)) + (pearl--log "Writing %d issues to %s (clean buffer)" + (length issues) org-file-path) + (with-current-buffer existing-buf + (let ((recorded-point (point)) + (inhibit-read-only t)) + (erase-buffer) + (insert new-content) + (save-buffer) + (goto-char (min recorded-point (point-max))) + (pearl--restore-page-visibility))) + (message "Updated Linear issues in %s with %d active issues" + org-file-path (length issues)) + (pearl--surface-buffer existing-buf)) + + ;; Branch C: buffer is dirty -- defer, do not overwrite, but show it. + (t + (pearl--log + "Linear refresh deferred: %s has unsaved changes (%d issues not written)" + org-file-path (length issues)) + (message + "Linear refresh deferred: %s has unsaved changes. Save or revert, then re-run M-x pearl-list-issues." + (file-name-nondirectory org-file-path)) + (pearl--surface-buffer existing-buf))))) + +(defcustom pearl-saved-queries nil + "Named local issue queries, run with `pearl-run-saved-query'. +Each entry is (NAME . SPEC) where SPEC is a plist with `:filter' (an authoring +filter plist), and optional `:sort' (`updated', `created', `priority', or +`title') and `:order' (`asc' or `desc', default `desc'). AND-only in v1; use a +Linear Custom View for OR logic." + :type '(alist :key-type string :value-type plist) + :group 'pearl) + +(defun pearl--sort-issues (issues sort order) + "Return ISSUES sorted by SORT (a symbol) in ORDER (`asc' or `desc'). +SORT is one of `updated', `priority', `title', or nil (no client-side sort). +ORDER defaults to descending. Sorting happens after fetch so a refresh always +produces the same heading order rather than reshuffling into noise." + (let ((key (pcase sort + ('updated (lambda (i) (or (plist-get i :updated-at) ""))) + ('priority (lambda (i) (or (plist-get i :priority) 99))) + ('title (lambda (i) (downcase (or (plist-get i :title) "")))) + (_ nil)))) + (if (null key) + issues + (let* ((lessp (if (eq sort 'priority) + (lambda (a b) (< (funcall key a) (funcall key b))) + (lambda (a b) (string< (funcall key a) (funcall key b))))) + (ascending (sort (copy-sequence issues) lessp))) + (if (eq order 'asc) ascending (nreverse ascending)))))) + +(defun pearl--sort->order-by (sort) + "Map a SORT symbol to the server `orderBy' value. +`created' uses `createdAt'; everything else (including `updated') uses +`updatedAt', the only other field Linear's public ordering supports." + (if (eq sort 'created) 'createdAt 'updatedAt)) + +;;;###autoload +(defun pearl-run-saved-query (name) + "Run the saved query NAME from `pearl-saved-queries'. +Interactively, completes over the configured query names. Compiles the stored +filter, fetches, sorts per the query's `:sort'/`:order', and renders into the +active file with the query recorded as the source." + (interactive + (list (completing-read "Saved query: " + (mapcar #'car pearl-saved-queries) nil t))) + (let ((entry (assoc name pearl-saved-queries))) + (unless entry + (user-error "No saved query named %s" name)) + (let* ((spec (cdr entry)) + (filter-plist (plist-get spec :filter)) + (sort (plist-get spec :sort)) + (order (plist-get spec :order)) + (source (list :type 'filter :name name :filter filter-plist + :sort sort :order order))) + (pearl--progress "Running saved query %s..." name) + (pearl--query-issues-async + (pearl--build-issue-filter filter-plist) + (lambda (result) (pearl--render-query-result result source)) + (pearl--sort->order-by sort))))) + +(defun pearl--assemble-filter (team open state project labels assignee) + "Assemble a filter authoring plist from the chosen dimensions. +The non-nil of TEAM, OPEN, STATE, PROJECT, LABELS, and ASSIGNEE appear (an +empty LABELS list is dropped), feeding `pearl--build-issue-filter' +with just what the user set." + (append + (when team (list :team team)) + (when assignee (list :assignee assignee)) + (when open (list :open t)) + (when state (list :state state)) + (when project (list :project project)) + (when labels (list :labels labels)))) + +(defun pearl--read-filter-interactively () + "Build a filter plist by completing over the chosen team's fetched dimensions. +Picks a team first (scoping the rest), then offers open-only, state, project, +labels, and assignee. Empty answers drop the dimension." + (let* ((teams (pearl--all-teams)) + (team-name (completing-read "Team (empty for any): " + (mapcar (lambda (tm) (cdr (assoc 'name tm))) teams) + nil nil)) + (team-id (and (not (string-empty-p team-name)) + (pearl--get-team-id-by-name team-name))) + (open (y-or-n-p "Open issues only? ")) + (state (and team-id + (let ((s (completing-read + "State (empty for any): " + (mapcar (lambda (st) (cdr (assoc 'name st))) + (pearl--team-states team-id)) + nil nil))) + (unless (string-empty-p s) s)))) + (project (and team-id + (let ((p (completing-read + "Project (empty for any): " + (pearl--team-collection-names 'projects team-id) + nil nil))) + (unless (string-empty-p p) p)))) + (labels (and team-id + (completing-read-multiple + "Labels (comma-separated, empty for none): " + (pearl--team-collection-names 'labels team-id)))) + (assignee (pcase (completing-read "Assignee (me / any): " '("me" "any") nil t "any") + ("me" :me) + (_ nil)))) + (pearl--assemble-filter + (and (not (string-empty-p team-name)) team-name) + open state project labels assignee))) + +(defun pearl--save-query (name filter-plist &optional sort order) + "Save FILTER-PLIST as the saved query NAME, replacing any entry of that NAME. +Persists `pearl-saved-queries' via Customize. SORT and ORDER are +stored when given." + (let ((entry (cons name (append (list :filter filter-plist) + (when sort (list :sort sort)) + (when order (list :order order)))))) + (setq pearl-saved-queries + (cons entry (assoc-delete-all name (copy-sequence pearl-saved-queries)))) + (ignore-errors + (customize-save-variable 'pearl-saved-queries pearl-saved-queries)))) + +;;;###autoload +(defun pearl-list-issues-filtered (filter-plist &optional save-name) + "Build an ad-hoc issue filter interactively, run it, and render it. +Interactively, completes each dimension from the chosen team's fetched +projects/states/labels (so a typo can't produce a confusing empty result), and +offers to save the filter as a local query. FILTER-PLIST is the authoring +filter; SAVE-NAME, when given, persists it via `pearl--save-query'." + (interactive + (list (pearl--read-filter-interactively) + (when (y-or-n-p "Save as a local query? ") + (read-string "Query name: ")))) + (when (and save-name (not (string-empty-p save-name))) + (pearl--save-query save-name filter-plist)) + (let ((source (list :type 'filter + :name (if (and save-name (not (string-empty-p save-name))) + save-name + "Ad-hoc filter") + :filter filter-plist))) + (pearl--progress "Running ad-hoc filter...") + (pearl--query-issues-async + (pearl--build-issue-filter filter-plist) + (lambda (result) (pearl--render-query-result result source))))) + +(defun pearl--render-query-result (result source) + "Render a query RESULT into the active file, tagged with SOURCE. +Normalizes the raw nodes, writes them via `pearl--update-org-from-issues' +with SOURCE and the truncation flag, and reports the outcome. The one render +boundary shared by list-issues, the ad-hoc filter, saved queries, views, and +refresh." + (pcase (pearl--query-result-status result) + ('ok + (let ((issues (pearl--sort-issues + (mapcar #'pearl--normalize-issue + (pearl--query-result-issues result)) + (plist-get source :sort) + (plist-get source :order))) + (truncated (pearl--query-result-truncated-p result))) + (condition-case err + (progn + (pearl--update-org-from-issues issues source truncated) + (message "Linear: wrote %d issue%s%s" + (length issues) + (if (= 1 (length issues)) "" "s") + (if truncated + (format " (stopped at the %d-page limit; raise `pearl-max-issue-pages')" + pearl-max-issue-pages) + ""))) + (error + (pearl--log "Error updating org file: %s" (error-message-string err)) + (message "Error updating the Linear org file: %s" + (error-message-string err)))))) + ('empty + (message "Linear: no issues match %s (file left unchanged)" + (pearl--source-name source))) + (_ + (message "Linear: %s" + (or (pearl--query-result-message result) + "could not fetch issues"))))) + +(defun pearl--subtree-dirty-p () + "Return non-nil when the issue subtree at point has unpushed body edits. +Compares the current Org body against `LINEAR-DESC-ORG-SHA256', the hash of the +body as it was rendered at the last fetch. This is an Org-to-Org comparison: it +does not round-trip through markdown, so a description whose markdown does not +survive md->org->md (headings, single-asterisk emphasis) is not mistaken for a +local edit. This is what lets a refresh protect a locally edited description +from being clobbered while still re-rendering the untouched ones. + +For subtrees rendered before this hash existed (no `LINEAR-DESC-ORG-SHA256'), +fall back to the older markdown-round-trip comparison; those migrate to the +Org-baseline hash the next time the subtree is re-rendered." + (let ((org-hash (org-entry-get nil "LINEAR-DESC-ORG-SHA256"))) + (if org-hash + (not (string= (secure-hash 'sha256 (pearl--issue-body-at-point)) org-hash)) + (let ((stored (org-entry-get nil "LINEAR-DESC-SHA256")) + (local-md (pearl--org-to-md (pearl--issue-body-at-point)))) + (not (string= (secure-hash 'sha256 local-md) (or stored ""))))))) + +(defun pearl--issue-subtree-markers () + "Return an alist of (LINEAR-ID . marker) for every issue heading in the buffer. +Each marker sits at the start of an issue heading -- one carrying its own +`LINEAR-ID' property. Comment headings carry `LINEAR-COMMENT-ID' instead and +have no `LINEAR-ID', so they are skipped. Markers (not raw positions) so they +track correctly across the in-place inserts and deletes the merge performs." + (let (markers) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^\\*+ " nil t) + (save-excursion + (beginning-of-line) + (let ((id (org-entry-get nil "LINEAR-ID"))) + (when (and id (not (string-empty-p id))) + ;; Insertion type t matters here: replacing an earlier subtree + ;; deletes then reinserts at its start, collapsing a later + ;; marker onto that point. A type-nil marker would stay before + ;; the reinserted text and get stranded on the wrong heading; a + ;; type-t marker advances past it to its own heading. + (push (cons id (copy-marker (point) t)) markers)))))) + (nreverse markers))) + +(defun pearl--merge-issues-into-buffer (issues) + "Merge normalized ISSUES into the current buffer by `LINEAR-ID'. +Same-source refresh semantics: an existing issue still in ISSUES is re-rendered +in place; an issue new to ISSUES is appended after the last one; an issue no +longer in ISSUES is dropped. A subtree whose body has unpushed edits (see +`pearl--subtree-dirty-p') is never overwritten and never dropped -- it is kept +and counted, so a refresh can't lose un-synced work. Returns a plist of counts +\(:updated :added :dropped :skipped)." + (let ((existing (pearl--issue-subtree-markers)) + (fetched-ids (mapcar (lambda (i) (plist-get i :id)) issues)) + (updated 0) (added 0) (dropped 0) (skipped 0)) + ;; Existing issues still in the result: re-render in place, unless dirty. + (dolist (issue issues) + (let ((marker (cdr (assoc (plist-get issue :id) existing)))) + (when marker + (save-excursion + (goto-char marker) + (if (pearl--subtree-dirty-p) + (setq skipped (1+ skipped)) + (pearl--replace-issue-subtree-at-point issue) + (setq updated (1+ updated))))))) + ;; Existing issues absent from the result: drop them, but keep dirty ones. + (dolist (cell existing) + (unless (member (car cell) fetched-ids) + (save-excursion + (goto-char (cdr cell)) + (if (pearl--subtree-dirty-p) + (setq skipped (1+ skipped)) + (org-back-to-heading t) + (delete-region (point) (progn (org-end-of-subtree t t) (point))) + (setq dropped (1+ dropped)))))) + ;; Issues new to the result: append after the last one, in fetched order. + (dolist (issue issues) + (unless (assoc (plist-get issue :id) existing) + (save-excursion + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert (pearl--format-issue-as-org-entry issue))) + (setq added (1+ added)))) + (list :updated updated :added added :dropped dropped :skipped skipped))) + +(defun pearl--update-source-header (issue-count truncated) + "Refresh the active file's run-at, count, and truncation header lines. +ISSUE-COUNT is the new issue total; TRUNCATED marks a page-cap hit. The +`#+LINEAR-SOURCE:' descriptor is left untouched -- only the human-readable +provenance advances on a refresh." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^#\\+LINEAR-RUN-AT: .*$" nil t) + (replace-match (format "#+LINEAR-RUN-AT: %s" + (format-time-string "%Y-%m-%d %H:%M")) + t t)) + (goto-char (point-min)) + (when (re-search-forward "^#\\+LINEAR-COUNT: .*$" nil t) + (replace-match (format "#+LINEAR-COUNT: %d" issue-count) t t)) + (goto-char (point-min)) + (when (re-search-forward "^#\\+LINEAR-TRUNCATED: .*$" nil t) + (replace-match (format "#+LINEAR-TRUNCATED: %s" (if truncated "yes" "no")) t t)))) + +(defun pearl--merge-query-result (result source) + "Merge a query RESULT into the current buffer by `LINEAR-ID', tagged with SOURCE. +The same-source refresh counterpart to `pearl--render-query-result': rather than +replacing the file, it updates issue subtrees in place, appends new matches, and +drops issues no longer present (protecting unpushed edits per subtree), then +refreshes the provenance header. An empty result leaves the buffer untouched +rather than dropping every issue, mirroring the non-destructive empty handling +of the replace path." + (pcase (pearl--query-result-status result) + ('ok + (let* ((issues (pearl--sort-issues + (mapcar #'pearl--normalize-issue + (pearl--query-result-issues result)) + (plist-get source :sort) + (plist-get source :order))) + (truncated (pearl--query-result-truncated-p result)) + (counts (pearl--merge-issues-into-buffer issues))) + (pearl--update-source-header (length issues) truncated) + (pearl-highlight-comments) + (pearl--restore-page-visibility) + (pearl--surface-buffer (current-buffer)) + (message "Refreshed %s: %d updated, %d added, %d dropped%s" + (pearl--source-name source) + (plist-get counts :updated) + (plist-get counts :added) + (plist-get counts :dropped) + (let ((s (plist-get counts :skipped))) + (if (> s 0) (format ", %d kept (unpushed edits)" s) ""))))) + ('empty + (message "Linear: %s now matches no issues (file left unchanged)" + (pearl--source-name source))) + (_ + (message "Linear: %s" + (or (pearl--query-result-message result) + "could not refresh issues"))))) + +;;;###autoload +(defun pearl-refresh-current-view () + "Re-run the active source recorded in the current file's header and merge it in. +Reads the `#+LINEAR-SOURCE:' descriptor, re-fetches it, and merges the result +into this buffer by `LINEAR-ID' (see `pearl--merge-query-result'): existing +issues update in place, new matches are appended, and issues no longer present +are dropped, while any subtree with unpushed edits is kept. This is the +same-source counterpart to the replace-on-switch behavior of the query and view +commands. Errors if no source is recorded." + (interactive) + (let ((source (pearl--read-active-source)) + (buffer (current-buffer))) + (unless source + (user-error "No Linear source recorded in this file; run a query or view first")) + (let ((merge (lambda (result) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (pearl--merge-query-result result source)))))) + (pcase (plist-get source :type) + ('filter + (pearl--progress "Refreshing %s..." (pearl--source-name source)) + (pearl--query-issues-async + (pearl--build-issue-filter (plist-get source :filter)) + merge)) + ('view + (pearl--progress "Refreshing %s..." (pearl--source-name source)) + (pearl--query-view-async (plist-get source :id) merge)) + (_ (user-error "Unknown Linear source type: %s" (plist-get source :type))))))) + +;;;###autoload +(defun pearl-run-view (view-name) + "Run a Linear Custom View by VIEW-NAME and render it into the active file. +Interactively, completes over the workspace's Custom Views. The view's own +filter runs server-side; the result replaces the active file (behind the +dirty-buffer guard) and records the view as the active source." + (interactive + (list (completing-read "Custom view: " + (mapcar (lambda (v) (cdr (assoc 'name v))) + (pearl--custom-views)) + nil t))) + (let* ((view (seq-find (lambda (v) (string= (cdr (assoc 'name v)) view-name)) + (pearl--custom-views))) + (view-id (and view (cdr (assoc 'id view))))) + (unless view-id + (user-error "No Custom View named %s" view-name)) + (let ((source (list :type 'view :name view-name :id view-id + :url (cdr (assoc 'url view))))) + (pearl--progress "Running view %s..." view-name) + (pearl--query-view-async + view-id + (lambda (result) (pearl--render-query-result result source)))))) + +;;;###autoload +(defun pearl-open-current-view-in-linear () + "Open the active view's source URL in the browser. +Reads the recorded source from the file header; errors when the source is not +a view or has no URL." + (interactive) + (let* ((source (pearl--read-active-source)) + (url (plist-get source :url))) + (unless (and url (not (string-empty-p url))) + (user-error "The active source has no view URL to open")) + (browse-url url))) + +;;;###autoload +(defun pearl-list-issues (&optional project-id) + "Fetch my open Linear issues into `pearl-org-file-path' and show them. +With PROJECT-ID, narrow to that project. \"Open\" means any workflow state +that is not completed, canceled, or duplicate. Runs asynchronously. + +Inclusion is server-side via the issue filter; the state mapping only drives +how each issue's state renders as a TODO keyword." + (interactive) + (pearl--log "Executing pearl-list-issues") + (pearl--progress "Fetching issues from Linear...") + (let* ((authoring `(:assignee :me :open t + ,@(when project-id (list :project project-id)))) + (source (list :type 'filter + :name (if project-id "My open issues in project" "My open issues") + :filter authoring)) + (filter (pearl--build-issue-filter authoring))) + (pearl--query-issues-async + filter + (lambda (result) (pearl--render-query-result result source))))) + +;;;###autoload +(defun pearl-list-issues-by-project () + "List Linear issues filtered by a selected project. +Uses async API for better performance." + (interactive) + (let* ((team (if pearl-default-team-id + (list (cons 'id pearl-default-team-id)) + (pearl-select-team))) + (team-id (cdr (assoc 'id team)))) + (if team-id + (let* ((project (pearl-select-project team-id)) + (project-id (and project (cdr (assoc 'id project))))) + (if project-id + (progn + (message "Fetching issues for project: %s" (cdr (assoc 'name project))) + (pearl-list-issues project-id)) + (message "No project selected"))) + (message "No team selected")))) + +;;;###autoload +(defun pearl-new-issue () + "Create a new Linear issue with additional attributes." + (interactive) + ;; Select team first (needed for states, members, etc.) + (let* ((team (if pearl-default-team-id + (list (cons 'id pearl-default-team-id)) + (pearl-select-team))) + (team-id (cdr (assoc 'id team)))) + + (if team-id + (let* ((title (read-string "Issue title: ")) + (description (read-string "Description: ")) + + ;; Get workflow states + (states (pearl-get-states team-id)) + (state-options (when states + (mapcar (lambda (state) + (cons (cdr (assoc 'name state)) + (cdr (assoc 'id state)))) + states))) + (selected-state (when state-options + (cdr (assoc (completing-read "State: " state-options nil t) + state-options)))) + + ;; Get priorities + (priority-options (pearl-get-priorities)) + (selected-priority (cdr (assoc (completing-read "Priority: " priority-options nil t) + priority-options))) + + ;; Get team members for assignee + (members (pearl-get-team-members team-id)) + (assignee-prompt (completing-read + "Assignee: " + (mapcar #'car members) + nil nil nil nil "")) + (selected-assignee (unless (string-empty-p assignee-prompt) + (cdr (assoc assignee-prompt members)))) + + ;; Estimate (points) + (estimate (read-string "Estimate (points, leave empty for none): ")) + (estimate-num (when (and estimate (not (string-empty-p estimate))) + (string-to-number estimate))) + + ;; Issue type (label) + (issue-types (pearl-get-issue-types team-id)) + (label-names (mapcar #'car issue-types)) + ;; Group labels by category (e.g., "Docs", "Feature", etc.) + (label-categories (let ((categories (make-hash-table :test 'equal))) + (dolist (label label-names) + (when-let* ((parts (split-string label " - " t)) + (category (car parts))) + (puthash category + (cons label (gethash category categories nil)) + categories))) + categories)) + (category-names (hash-table-keys label-categories)) + ;; First select a category, then a specific label + (selected-category (completing-read + "Label category: " + (append '("All") category-names) + nil nil nil nil "All")) + (filtered-labels (if (string= selected-category "All") + label-names + (gethash selected-category label-categories nil))) + (label-prompt (completing-read + (if (string= selected-category "All") + "Label (type for fuzzy search): " + (format "Label in %s category: " selected-category)) + filtered-labels + nil nil nil nil "")) + (matching-labels (when (not (string-empty-p label-prompt)) + (cl-remove-if-not + (lambda (label-name) + (string-match-p (regexp-quote label-prompt) label-name)) + filtered-labels))) + (selected-label-name (if (= (length matching-labels) 1) + (car matching-labels) + (when matching-labels + (completing-read "Select specific label: " matching-labels nil t)))) + (selected-type (when (and selected-label-name (not (string-empty-p selected-label-name))) + (cdr (assoc selected-label-name issue-types)))) + + ;; Get project + (selected-project (pearl-select-project team-id)) + (selected-project-id (and selected-project (cdr (assoc 'id selected-project)))) + + ;; Prepare mutation + (query "mutation CreateIssue($input: IssueCreateInput!) { + issueCreate(input: $input) { + success + issue { + id + identifier + title + } + } + }") + + ;; Build input variables + (input `(("title" . ,title) + ("description" . ,description) + ("teamId" . ,team-id) + ,@(when selected-state + `(("stateId" . ,selected-state))) + ,@(when selected-priority + `(("priority" . ,selected-priority))) + ,@(when selected-assignee + `(("assigneeId" . ,selected-assignee))) + ,@(when estimate-num + `(("estimate" . ,estimate-num))) + ,@(when selected-type + `(("labelIds" . [,selected-type]))) + ,@(when selected-project-id + `(("projectId" . ,selected-project-id))))) + + (response (pearl--graphql-request query `(("input" . ,input))))) + + (let ((issue (pearl--created-issue response))) + (if issue + (progn + (message "Created issue %s: %s" + (cdr (assoc 'identifier issue)) + (cdr (assoc 'title issue))) + issue) + (message "Failed to create issue")))) + + (message "No team selected")))) + +;;;###autoload +(defun pearl-test-connection () + "Test the connection to Linear API." + (interactive) + (pearl--log "Testing connection to Linear API") + (pearl--progress "Testing Linear API connection...") + + (let* ((query "query { viewer { id name } }")) + (pearl--graphql-request-async + query + nil + (lambda (response) + (if response + (let ((viewer (assoc 'viewer (assoc 'data response)))) + (message "Connected to Linear as: %s" (cdr (assoc 'name viewer)))) + (message "Failed to connect to Linear API"))) + (lambda (_error _response _data) + (message "Failed to connect to Linear API"))))) + +;;;###autoload +(defun pearl-toggle-debug () + "Toggle debug logging for Linear API requests." + (interactive) + (setq pearl-debug (not pearl-debug)) + (message "Linear debug mode %s" (if pearl-debug "enabled" "disabled"))) + +;;;###autoload +(defun pearl-check-setup () + "Check if Linear.el is properly set up." + (interactive) + (if pearl-api-key + (progn + (message "API key is set (length: %d). Testing connection..." (length pearl-api-key)) + (pearl-test-connection)) + (message "Linear API key is not set. Use M-x customize-variable RET pearl-api-key"))) + +;;;###autoload +(defun pearl-load-api-key-from-env () + "Try to load Linear API key from environment variable." + (interactive) + (let ((env-key (getenv "LINEAR_API_KEY"))) + (if env-key + (progn + (setq pearl-api-key env-key) + (message "Loaded Linear API key from LINEAR_API_KEY environment variable")) + (message "LINEAR_API_KEY environment variable not found or empty")))) + +;;; Org Mode Sync Hooks + +;;;###autoload +(defun pearl-enable-org-sync () + "Enable synchronization between org mode and Linear." + (interactive) + (add-hook 'after-save-hook #'pearl-org-hook-function nil t) + (add-hook 'org-after-todo-state-change-hook #'pearl-sync-org-to-linear nil t) + (pearl-highlight-comments) + (message "Linear-org synchronization enabled")) + +;;;###autoload +(defun pearl-disable-org-sync () + "Disable synchronization between org mode and Linear." + (interactive) + (remove-hook 'after-save-hook #'pearl-org-hook-function t) + (remove-hook 'org-after-todo-state-change-hook #'pearl-sync-org-to-linear t) + (message "Linear-org synchronization disabled")) + +;;; Comment Editing + +(defface pearl-editable-comment + '((t :inherit success)) + "Face for comment headings the current user can edit." + :group 'pearl) + +(defface pearl-readonly-comment + '((t :inherit shadow)) + "Face for comment headings the current user cannot edit." + :group 'pearl) + +(defun pearl--comment-editable-p (author-id viewer-id) + "Return non-nil when a comment by AUTHOR-ID is editable by VIEWER-ID. +Editable only when both ids are present and equal; a nil or empty AUTHOR-ID +\(bot or external comment) is never editable." + (and author-id viewer-id + (not (string-empty-p author-id)) + (string= author-id viewer-id))) + +(defun pearl--viewer-async (callback) + "Resolve the current Linear viewer and call CALLBACK with a plist (:id :name). +Caches the result in `pearl--cache-viewer'; calls CALLBACK with nil on a +transport or GraphQL failure." + (if pearl--cache-viewer + (funcall callback pearl--cache-viewer) + (pearl--graphql-request-async + "query { viewer { id name } }" nil + (lambda (data) + (let ((v (cdr (assoc 'viewer (assoc 'data data))))) + (funcall callback + (when v + (setq pearl--cache-viewer + (list :id (cdr (assoc 'id v)) + :name (cdr (assoc 'name v)))))))) + (lambda (_error _response _data) (funcall callback nil))))) + +(defun pearl--fetch-comment-body-async (comment-id callback) + "Fetch COMMENT-ID's current body from Linear. +CALLBACK is called with the markdown body string on success, or nil on error." + (let ((query "query CommentBody($id: String!) { + comment(id: $id) { body } + }") + (variables `(("id" . ,comment-id)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let ((comment (cdr (assoc 'comment (assoc 'data data))))) + (funcall callback (when comment (or (cdr (assoc 'body comment)) ""))))) + (lambda (_error _response _data) (funcall callback nil))))) + +(defun pearl--update-comment-async (comment-id body callback) + "Push BODY as COMMENT-ID's text via commentUpdate. +CALLBACK is called with a plist (:success BOOL)." + (let ((query "mutation UpdateComment($id: String!, $body: String!) { + commentUpdate(id: $id, input: {body: $body}) { + success + comment { id body } + } + }") + (variables `(("id" . ,comment-id) ("body" . ,body)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let* ((payload (cdr (assoc 'commentUpdate (assoc 'data data)))) + (success (eq t (cdr (assoc 'success payload))))) + (funcall callback (list :success success)))) + (lambda (_error _response _data) (funcall callback '(:success nil)))))) + +(defun pearl--apply-comment-highlights (viewer-id) + "Color every comment heading in the buffer by editability for VIEWER-ID. +The viewer's own comments get `pearl-editable-comment'; all others get +`pearl-readonly-comment'. Idempotent: clears prior highlights first." + (save-excursion + (remove-overlays (point-min) (point-max) 'pearl-comment t) + (goto-char (point-min)) + (while (re-search-forward "^\\*+ " nil t) + (let ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID"))) + (when comment-id + (let* ((author-id (org-entry-get nil "LINEAR-COMMENT-AUTHOR-ID")) + (face (if (pearl--comment-editable-p author-id viewer-id) + 'pearl-editable-comment + 'pearl-readonly-comment)) + (ov (make-overlay (line-beginning-position) (line-end-position)))) + (overlay-put ov 'pearl-comment t) + (overlay-put ov 'face face))))))) + +;;;###autoload +(defun pearl-highlight-comments () + "Color comment headings in the current buffer by who can edit them. +The viewer's own comments render green (editable); others render greyed. Runs +after a fetch/refresh and from `pearl-enable-org-sync', and is safe to +invoke by hand." + (interactive) + (let ((buffer (current-buffer))) + ;; Best-effort: highlighting is a display nicety and must never abort the + ;; operation that triggered it (e.g. a missing API key errors in the + ;; request layer), so a failure to resolve the viewer just skips coloring. + (ignore-errors + (pearl--viewer-async + (lambda (viewer) + (when (and viewer (buffer-live-p buffer)) + (with-current-buffer buffer + (pearl--apply-comment-highlights (plist-get viewer :id))))))))) + +;;;###autoload +(defun pearl-edit-current-comment () + "Push an edit to the comment at point on Linear. +Works from anywhere inside a comment's subtree. Only the current user's own +comments are editable: a comment authored by anyone else (or by a bot or +integration) is refused without a network call. The push is gated like the +description sync -- unchanged since fetch sends nothing, a local edit against +an unchanged remote pushes, and a both-sides-changed case is refused and +reported (refresh to reconcile)." + (interactive) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear comment")) + (let ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID")) + (author-id (org-entry-get nil "LINEAR-COMMENT-AUTHOR-ID")) + (stored (org-entry-get nil "LINEAR-COMMENT-SHA256")) + (marker (point-marker))) + (unless comment-id + (user-error "Not on a Linear comment")) + ;; `pearl--issue-body-at-point' reads the text after the drawer and before + ;; the first child heading -- a comment subtree has that same shape, so the + ;; description path's body reader serves the comment body unchanged. + (let ((local-md (pearl--org-to-md (pearl--issue-body-at-point)))) + (if (string= (secure-hash 'sha256 local-md) (or stored "")) + (message "No comment changes to sync") + (pearl--viewer-async + (lambda (viewer) + (cond + ((null viewer) + (message "Could not determine your Linear identity; not editing")) + ((not (pearl--comment-editable-p author-id (plist-get viewer :id))) + (message "You can only edit your own comments")) + (t + (pearl--progress "Checking Linear for remote changes...") + (pearl--fetch-comment-body-async + comment-id + (lambda (remote-md) + (if (null remote-md) + (message "Could not fetch the comment from Linear; not syncing") + (pcase (pearl--sync-decision local-md stored remote-md) + (:noop (message "Comment already matches Linear")) + (:conflict + (pearl--resolve-conflict + "comment" + local-md remote-md marker "LINEAR-COMMENT-SHA256" + (lambda (md) + (org-with-point-at marker + (pearl--set-entry-body-at-point (pearl--md-to-org md)))) + (lambda (md cb) + (pearl--update-comment-async + comment-id md + (lambda (r) (funcall cb (plist-get r :success))))))) + (:push + (pearl--update-comment-async + comment-id local-md + (lambda (result) + (if (plist-get result :success) + (progn + (org-entry-put marker "LINEAR-COMMENT-SHA256" + (secure-hash 'sha256 local-md)) + (message "Synced comment to Linear") + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to sync comment")))))))))))))))))) + +;;; Transient Menu + +;;;###autoload (autoload 'pearl-menu "pearl" nil t) +(transient-define-prefix pearl-menu () + "Dispatch menu for pearl commands." + ["Linear" + ["Fetch" + ("l" "My open issues" pearl-list-issues) + ("p" "By project" pearl-list-issues-by-project) + ("f" "Build a filter" pearl-list-issues-filtered) + ("v" "Custom view" pearl-run-view) + ("Q" "Saved query" pearl-run-saved-query)] + ["View" + ("g" "Refresh view" pearl-refresh-current-view) + ("r" "Refresh issue" pearl-refresh-current-issue) + ("b" "Open view in Linear" pearl-open-current-view-in-linear)] + ["Issue at point" + ("e" "Edit desc -> push" pearl-sync-current-issue) + ("t" "Edit title -> push" pearl-sync-current-issue-title) + ("s" "Set state" pearl-set-state) + ("a" "Set assignee" pearl-set-assignee) + ("P" "Set priority" pearl-set-priority) + ("L" "Set labels" pearl-set-labels) + ("c" "Add comment" pearl-add-comment) + ("M" "Edit comment" pearl-edit-current-comment) + ("k" "Delete issue" pearl-delete-current-issue) + ("o" "Open in browser" pearl-open-current-issue)] + ["Create & org-sync" + ("n" "New issue" pearl-new-issue) + ("E" "Enable org-sync" pearl-enable-org-sync) + ("X" "Disable org-sync" pearl-disable-org-sync) + ("u" "Push file -> Linear" pearl-sync-org-to-linear)] + ["Setup" + ("T" "Test connection" pearl-test-connection) + ("C" "Check setup" pearl-check-setup) + ("!" "Toggle debug" pearl-toggle-debug) + ("x" "Clear cache" pearl-clear-cache)]]) + +(provide 'pearl) +;;; pearl.el ends here
\ No newline at end of file |