path: root/lisp/garden-fleet.el

;;; garden-fleet.el --- import & process fleeting notes -*- lexical-binding: t; -*-

(require 'garden-core)
(require 'garden-icons)
(require 'garden-preview)
(require 'vui)
(require 'vui-components)

(declare-function evil-define-key* "evil-core" (state keymap key def &rest bindings))
(declare-function evil-set-initial-state "evil-core" (mode state))

(defvar denote-directory)
(defvar denote-rename-confirmations)
(defvar denote-save-buffers)
(defvar denote-kill-buffers)
(declare-function denote-rename-file "denote")
(declare-function garden "garden-dashboard")

(defcustom garden-fleet-source-directory (expand-file-name "~/org/")
  "Directory scanned for fleeting notes to import."
  :type 'directory :group 'garden)

(defcustom garden-fleet-tags '("fleet" "capture")
  "Tags marking a note as fleeting."
  :type '(repeat string) :group 'garden)

(defcustom garden-fleet-data-file (expand-file-name ".garden/fleet.eld" garden-directory)
  "File persisting the manual ordering of staged fleet notes."
  :type 'file :group 'garden)

(defvar garden-fleet--order nil
  "List of staged note ids in their manual order.")

(defvar-local garden-fleet--dispatch nil
  "Async actions exposed by the mounted Fleet component.")

(defun garden-fleet--refresh ()
  "Re-render every live garden VUI buffer."
  (dolist (name '("*garden-fleet*" "*garden*" "*garden connect*"))
    (when-let* ((buf (get-buffer name))
                (root (buffer-local-value 'vui--root-instance buf)))
      (vui-rerender root))))

(defun garden-fleet--load-order ()
  "Load the staged-note order from `garden-fleet-data-file'."
  (setq garden-fleet--order
        (when (file-exists-p garden-fleet-data-file)
          (with-temp-buffer
            (insert-file-contents garden-fleet-data-file)
            (ignore-errors (read (current-buffer)))))))

(defun garden-fleet--save-order ()
  "Persist the staged-note order to `garden-fleet-data-file'."
  (make-directory (file-name-directory garden-fleet-data-file) t)
  (with-temp-file garden-fleet-data-file (prin1 garden-fleet--order (current-buffer))))

(defun garden-fleet--file-tags (file)
  "Return all tags encoded in FILE's name, provenance included."
  (let ((base (file-name-nondirectory file)))
    (when (string-match "__\\([a-zA-Z0-9_-]+\\)\\.org\\'" base)
      (split-string (match-string 1 base) "_" t))))

(defun garden-fleet--fleet-p (tags)
  "Return non-nil when TAGS marks a fleeting note."
  (seq-intersection tags garden-fleet-tags))

(defun garden-fleet--source-files ()
  "Return the Denote-named org files in `garden-fleet-source-directory'."
  (directory-files garden-fleet-source-directory t "\\`[0-9]\\{8\\}T[0-9]\\{6\\}.*\\.org\\'"))

(defun garden-fleet-candidates ()
  "Return fleeting files in the inbox not yet imported."
  (seq-filter (lambda (f)
                (and (garden-fleet--fleet-p (garden-fleet--file-tags f))
                     (not (garden-note (garden--file-id f)))))
              (garden-fleet--source-files)))

(defun garden-fleet-staged ()
  "Return imported fleet notes, manual order first, newest after."
  (let (acc)
    (maphash (lambda (_id note)
               (when (garden-fleet--fleet-p (garden-fleet--file-tags (garden-note-file note)))
                 (push note acc)))
             (garden-notes))
    (let ((by-id (make-hash-table :test 'equal)))
      (dolist (note acc) (puthash (garden-note-id note) note by-id))
      (let ((ordered (seq-keep (lambda (id) (gethash id by-id)) garden-fleet--order))
            (rest (seq-remove (lambda (note) (member (garden-note-id note) garden-fleet--order)) acc)))
        (append ordered (seq-sort-by #'garden-note-id #'string> rest))))))

(defun garden-fleet-import (file)
  "Move FILE from the inbox into the garden and stage it."
  (garden-fleet--load-order)
  (let* ((id (garden--file-id file))
         (dest (expand-file-name (file-name-nondirectory file) garden-directory)))
    (cond
     ((file-exists-p dest)
      (message "garden: %s already in the garden — skipped" (file-name-nondirectory file)))
     (t
      (rename-file file dest)
      (setq garden-fleet--order (append garden-fleet--order (list id)))
      (garden-fleet--save-order)
      (garden-build)
      (message "garden: imported %s" (file-name-nondirectory dest))))))

(defun garden-fleet-import-all ()
  "Import every fleeting note from the inbox after confirmation."
  (interactive)
  (let ((files (garden-fleet-candidates)))
    (when (and files
               (yes-or-no-p (format "Import all %d fleet/capture note(s) into the garden? " (length files))))
      (dolist (f files) (garden-fleet-import f))
      (garden-build))))

(defun garden-fleet--rename (file keywords)
  "Rename FILE via denote so its name carries exactly KEYWORDS."
  (require 'denote)
  (let ((denote-directory (file-name-as-directory (expand-file-name garden-directory)))
        (denote-rename-confirmations nil)
        (denote-save-buffers t)
        (denote-kill-buffers t))
    (denote-rename-file file 'keep-current keywords 'keep-current 'keep-current 'keep-current)))

(defun garden-fleet-classify (id)
  "Prompt for topic tags to add to the note with ID.
Suggested tags are listed first and marked in the completion UI."
  (let* ((note (garden-note id))
         (file (garden-note-file note))
         (current (garden-fleet--file-tags file))
         (suggested (garden-suggest-tags file))
         (choices (seq-difference (mapcar #'car (garden-keywords-sorted)) current))
         (choices (append suggested (seq-difference choices suggested)))
         (annotate (lambda (k)
                     (concat
                      (propertize (format "  %d notes" (gethash k (garden-keyword-counts) 0))
                                  'face 'completions-annotations)
                      (or (when (member k suggested)
                            (propertize (format "  %s suggested" (garden-icon 'sparkle))
                                        'face 'completions-annotations))
                          ""))))
         (prompt (if suggested
                     (format "Topic tag(s) for “%s” (%s maybe: %s): "
                             (garden-note-title note) (garden-icon 'sparkle)
                             (string-join suggested ", "))
                   (format "Topic tag(s) for “%s”: " (garden-note-title note))))
         (added (completing-read-multiple prompt (garden-completion-table choices annotate))))
    (when added
      (garden-fleet--rename file (delete-dups (append current added)))
      (garden-build))))

(defun garden-fleet-tag (id tag)
  "Add the single TAG to the note with ID without prompting."
  (let* ((note (garden-note id))
         (file (garden-note-file note))
         (current (garden-fleet--file-tags file)))
    (garden-fleet--rename file (delete-dups (append current (list tag))))
    (garden-build)
    (message "garden: tagged “%s” with %s" (garden-note-title note) tag)))

(defun garden-fleet-delete (id)
  "Trash the staged note with ID and drop it from the order."
  (garden-fleet--load-order)
  (when (garden-delete-note id)
    (setq garden-fleet--order (delete id garden-fleet--order))
    (garden-fleet--save-order)))

(defun garden-fleet-return (id)
  "Send the staged note with ID back to the ~/org inbox.
Moves its file to `garden-fleet-source-directory', drops it from
the manual order, and rebuilds the index."
  (garden-fleet--load-order)
  (let* ((note (garden-note id))
         (file (garden-note-file note))
         (dest (expand-file-name (file-name-nondirectory file) garden-fleet-source-directory)))
    (make-directory garden-fleet-source-directory t)
    (if (file-exists-p dest)
        (message "garden: %s already in ~/org — left in place" (file-name-nondirectory file))
      (when-let* ((buf (find-buffer-visiting file)))
        (kill-buffer buf))
      (rename-file file dest)
      (setq garden-fleet--order (delete id garden-fleet--order))
      (garden-fleet--save-order)
      (garden-build)
      (message "garden: returned “%s” to ~/org" (garden-note-title note)))))

(defun garden-fleet-discard (file)
  "Trash the inbox candidate FILE after confirmation."
  (when (yes-or-no-p (format "Move “%s” to the trash? " (garden--file-title file)))
    (let ((delete-by-moving-to-trash t))
      (delete-file file t))
    (message "garden: discarded %s" (file-name-nondirectory file))))

(defun garden-fleet-graduate (id)
  "Remove the fleeting tags from the note with ID after confirmation."
  (garden-fleet--load-order)
  (let* ((note (garden-note id))
         (file (garden-note-file note))
         (keywords (seq-remove (lambda (k) (member k garden-fleet-tags))
                               (garden-fleet--file-tags file))))
    (when (yes-or-no-p (format "Graduate “%s” out of fleet? " (garden-note-title note)))
      (garden-fleet--rename file keywords)
      (setq garden-fleet--order (delete id garden-fleet--order))
      (garden-fleet--save-order)
      (garden-build)
      (message "garden: graduated %s" (garden-note-title note)))))

(defun garden-fleet-move (id delta)
  "Move the staged note with ID by DELTA positions in the order."
  (garden-fleet--load-order)
  (let* ((ids (mapcar #'garden-note-id (garden-fleet-staged)))
         (pos (seq-position ids id))
         (new (and pos (+ pos delta))))
    (when (and pos new (>= new 0) (< new (length ids)))
      (let ((other (nth new ids)))
        (setq garden-fleet--order
              (mapcar (lambda (x) (cond ((equal x id) other) ((equal x other) id) (t x))) ids))
        (garden-fleet--save-order)))))

(defun garden-fleet--topic-tags (file)
  "Return FILE's topic keywords, with provenance and status dropped."
  (seq-difference (garden--file-keywords file) garden-fleet-tags))

(defun garden-fleet--icon-action (icon help on-click &optional face label)
  "Render a quiet ICON button with HELP tooltip running ON-CLICK."
  (vui-button (if label (format "%s %s" (garden-icon icon) label)
                (garden-icon icon))
    :no-decoration (null label) :help-echo help :face face :on-click on-click))

(defun garden-fleet--candidate-row (file width)
  "Render an inbox card for FILE using WIDTH."
  (let ((tags-str (string-join (garden-fleet--topic-tags file) " "))
        (actions (vui-hstack :spacing 1
                   (garden-fleet--icon-action 'import "import into the garden"
                     (lambda () (unwind-protect (garden-fleet-import file) (garden-fleet--refresh)))
                     'success "import")
                   (garden-fleet--icon-action 'preview "peek in the side window"
                     (lambda () (garden-preview-show file)) 'link)
                   (garden-fleet--icon-action 'delete "move to the trash"
                     (lambda () (unwind-protect (garden-fleet-discard file) (garden-fleet--refresh)))
                     'error))))
    (vui-vstack
     :spacing 0 :face 'fringe
     (vui-flex
      :width width :justify :space-between
      (vui-flex-item
       :grow 1
       (lambda (available)
         (vui-button (garden--file-title file)
                     :key file :no-decoration t :help-echo file
                     :max-width available :face '(:inherit bold)
                     :on-click (lambda () (find-file file)))))
      (vui-muted "inbox"))
     (vui-box (vui-text (if (string-empty-p tags-str)
                            "no topic tags"
                          (format "#%s" (string-replace " " "  #" tags-str)))
                        :face 'shadow)
              :width width :padding-left 2)
     actions)))

(defun garden-fleet--chips (id tags)
  "Return a dot-separated list of one-click chips tagging note ID."
  (let (out)
    (dolist (tag tags)
      (when out (push (vui-muted "·") out))
      (push (vui-button tag
              :no-decoration t
              :help-echo (format "click to tag with “%s” right away" tag)
              :on-click (lambda () (unwind-protect (garden-fleet-tag id tag) (garden-fleet--refresh))))
            out))
    (nreverse out)))

(defun garden-fleet--suggestion-chips (id file)
  "Render one-click suggested-tag chips for the note ID in FILE.
The chips line up beneath the title column of the staged row above."
  (let ((suggested (garden-suggest-tags file)))
    (when suggested
      (apply #'vui-hstack :spacing 1
             (vui-muted "maybe →")
             (garden-fleet--chips id suggested)))))

(defun garden-fleet--staged-row (note width)
  "Render a staged card for NOTE using WIDTH."
  (let* ((id (garden-note-id note))
         (file (garden-note-file note))
         (tags-str (string-join (garden-fleet--topic-tags file) " "))
         (queue (vui-hstack :spacing 1
                  (garden-fleet--icon-action 'up "move up the queue"
                    (lambda () (unwind-protect (garden-fleet-move id -1) (garden-fleet--refresh))))
                  (garden-fleet--icon-action 'down "move down the queue"
                    (lambda () (unwind-protect (garden-fleet-move id 1) (garden-fleet--refresh))))))
         (actions (vui-hstack :spacing 1
                    (garden-fleet--icon-action 'classify "add topic tags"
                      (lambda () (unwind-protect (garden-fleet-classify id) (garden-fleet--refresh)))
                      'link "classify")
                    (garden-fleet--icon-action 'graduate "graduate out of fleet"
                      (lambda () (unwind-protect (garden-fleet-graduate id) (garden-fleet--refresh)))
                      'success "graduate")
                    (garden-fleet--icon-action 'preview "peek in the side window"
                      (lambda () (garden-preview-show file)) 'link)
                    (garden-fleet--icon-action 'return "send back to the ~/org inbox"
                      (lambda () (unwind-protect (garden-fleet-return id) (garden-fleet--refresh)))
                      'warning))))
    (vui-vstack :spacing 0 :face 'fringe
      (vui-flex :width width :justify :space-between
        queue
        (vui-flex-item :grow 1
          (lambda (w)
            (vui-button (garden-note-title note)
                        :key id :no-decoration t :help-echo file
                        :max-width w :face '(:inherit bold)
                        :on-click (lambda () (find-file file)))))
        (vui-muted "staged"))
      (vui-box (vui-text (if (string-empty-p tags-str)
                             "no topic tags"
                           (format "#%s" (string-replace " " "  #" tags-str)))
                         :face 'shadow)
               :width width :padding-left 2)
      (garden-fleet--suggestion-chips id file)
      actions)))

(defun garden-fleet--header ()
  "Render the fleet dashboard banner."
  (let ((icon (garden-icon 'fleet))
        (wave (garden-icon 'leaf)))
    (vui-vstack
     (vui-text (format "~  %s  ~  %s  ~  %s  ~" wave icon wave) :face 'garden-meta)
     (vui-heading-1 (format "%s  fleeting notes" icon))
     (vui-muted "import from ~/org, then order · classify · redo them"))))

(defun garden-fleet--window-width ()
  "Return the live Fleet window body width."
  (if-let* ((window (get-buffer-window (current-buffer) t)))
      (window-body-width window)
    (window-width)))

(defun garden-fleet--panel (title empty items renderer width)
  "Render a Fleet panel with TITLE, EMPTY message and ITEMS.
RENDERER receives each item and WIDTH."
  (vui-vstack
   :spacing 1
   (vui-flex :width width :justify :space-between
             (vui-heading-2 title)
             (vui-text (number-to-string (length items)) :face 'shadow))
   (if (null items)
       (vui-box (vui-text empty :face 'shadow) :width width :align :center)
     (vui-list items
               (lambda (item) (funcall renderer item width))
               (lambda (item)
                 (if (stringp item) item (garden-note-id item)))
               :spacing 1))))

(defun garden-fleet--view ()
  "Render the fleet dashboard: inbox candidates and staged notes."
  (let* ((candidates (garden-fleet-candidates))
         (staged (garden-fleet-staged))
         (width (garden-fleet--window-width))
         (wide (>= width 100))
         (panel-width (if wide (max 42 (/ (- width 6) 2)) (max 28 (- width 4))))
         (refresh (vui-with-async-context
                    (garden-refresh)
                    (garden-fleet--refresh))))
    (setq garden-fleet--dispatch (list :refresh refresh))
    (vui-vstack :spacing 1 :indent 2
      (garden-fleet--header)
      (vui-flex :width 'window :justify :space-between
       (vui-hstack :spacing 2
        (vui-button (concat (garden-icon 'refresh) " rescan")
          :on-click refresh)
        (vui-button (concat (garden-icon 'import) " import all")
          :on-click (lambda () (unwind-protect (garden-fleet-import-all) (garden-fleet--refresh))))
        (vui-button (concat (garden-icon 'preview) " preview")
          :on-click (lambda () (garden-preview-mode 'toggle) (garden-fleet--refresh)))
        (vui-button (concat (garden-icon 'star) " garden")
          :on-click (lambda () (garden))))
       (vui-muted (format "%d inbox · %d staged" (length candidates) (length staged))))
      (if wide
          (vui-hstack
           :spacing 4
           (garden-fleet--panel
            (concat (garden-icon 'inbox) " inbox")
            "Inbox empty — nothing to import"
            candidates #'garden-fleet--candidate-row panel-width)
           (garden-fleet--panel
            (concat (garden-icon 'tools) " staged")
            "Nothing staged — import a note first"
            staged #'garden-fleet--staged-row panel-width))
        (vui-vstack
         :spacing 1
         (garden-fleet--panel
          (concat (garden-icon 'inbox) " inbox")
          "Inbox empty — nothing to import"
          candidates #'garden-fleet--candidate-row panel-width)
         (garden-fleet--panel
          (concat (garden-icon 'tools) " staged")
          "Nothing staged — import a note first"
          staged #'garden-fleet--staged-row panel-width)))
      (vui-flex :width 'window :justify :space-between
                (vui-muted "j/k move · TAB/S-TAB elements · RET/l activate")
                (vui-muted "g rescan · ? help · h garden · q close")))))

(vui-defcomponent garden-fleet-dashboard ()
  :render (garden-fleet--view))

(defun garden-fleet-refresh ()
  "Rescan and refresh the Fleet dashboard."
  (interactive)
  (if-let* ((fn (plist-get garden-fleet--dispatch :refresh)))
      (funcall fn)
    (user-error "Fleet dashboard is not ready")))

(defun garden-fleet-back ()
  "Return to a live Garden dashboard, or close Fleet."
  (interactive)
  (if-let* ((buffer (get-buffer "*garden*")))
      (switch-to-buffer buffer)
    (vui-quit)))

(defun garden-fleet-help ()
  "Show Fleet keyboard help."
  (interactive)
  (message "Garden Fleet: j/k move, TAB/S-TAB elements, RET/l activate, g rescan, h garden, q close"))

(defvar garden-fleet-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map vui-mode-map)
    (keymap-set map "j" #'next-line)
    (keymap-set map "k" #'previous-line)
    (keymap-set map "TAB" #'vui-forward)
    (keymap-set map "<backtab>" #'vui-backward)
    (keymap-set map "RET" #'vui-activate)
    (keymap-set map "l" #'vui-activate)
    (keymap-set map "g" #'garden-fleet-refresh)
    (keymap-set map "?" #'garden-fleet-help)
    (keymap-set map "h" #'garden-fleet-back)
    (keymap-set map "q" #'vui-quit)
    map))

(define-derived-mode garden-fleet-mode vui-mode "Garden-Fleet"
  "Manage the Garden fleeting-note queues."
  (hl-line-mode 1))

(with-eval-after-load 'evil
  (evil-set-initial-state 'garden-fleet-mode 'normal)
  (evil-define-key* '(normal motion) garden-fleet-mode-map
    (kbd "j") #'next-line (kbd "k") #'previous-line
    (kbd "RET") #'vui-activate (kbd "l") #'vui-activate
    (kbd "g") #'garden-fleet-refresh (kbd "?") #'garden-fleet-help
    (kbd "h") #'garden-fleet-back (kbd "q") #'vui-quit))

;;;###autoload
(defun garden-fleet ()
  "Open the fleet dashboard for importing and classifying fleeting notes."
  (interactive)
  (garden-build)
  (garden-fleet--load-order)
  (let ((buffer (get-buffer-create "*garden-fleet*")))
    (with-current-buffer buffer
      (garden-fleet-mode)
      (vui-mount (vui-component 'garden-fleet-dashboard) buffer)
      (vui-rerender-on-resize))
    (switch-to-buffer buffer)))

(provide 'garden-fleet)
;;; garden-fleet.el ends here