;;; org-find-file-tags.el --- select files based on org-mode tags. -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2023 Howard X. Abrams
;;
;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
;; Maintainer: Howard X. Abrams <howard.abrams@gmail.com>
;; Created: January 8, 2023
;;
;; This file is not part of GNU Emacs.
;;
;; *NB:* Do not edit this file. Instead, edit the original literate file at:
;;            ~/website/Technical/Emacs/org-find-file-tags.org
;;       And tangle the file to recreate this one.
;;
;;; Code:

(defvar org-find-files-tag-line-re
  (rx line-start
      (or
       (seq (one-or-more "*") " " (+? any) ":"
            (group (one-or-more (any alnum "@_#%:"))) ":")
       (seq "#+tags:" (one-or-more space)
            (group (one-or-more (any alnum "@_#%" space)))))
      line-end)
  "Regular expression that matches either headline or global file tags.")

(require 'pcre2el)

(defun org-grep-tags (project-dir)
  "Show `grep-mode' buffer of org files with tagged headlines.

If PROJECT-DIR is nil, searches in the current project."
  (interactive (list (read-directory-name "Directory: " (if (project-current)
                                         (project-root (project-current))
                                       default-directory))))

  (let ((command (format "rg --no-heading '%s' %s"
                         (rxt-elisp-to-pcre org-find-files-tag-line-re)
                         project-dir)))
    (grep command)))

(defun shell-command-to-list (command)
  "Return call to COMMAND as a list of strings for each line."
  (thread-first command
                shell-command-to-string
                (string-lines t)))

(defun org-tags-in-current (&optional dir)
  "Returns a list of tags available in a directory tree."
  (unless dir
    (setq dir (if (project-current)
                  (project-root (project-current))
                default-directory)))
  (let* ((command (format "rg --ignore-case --no-heading --no-line-number --no-filename '%s' %s"
                          (rxt-elisp-to-pcre org-find-files-tag-line-re) dir))
         (output  (shell-command-to-list command))
         (tags    (thread-last output
                               (seq-map 'org-tags-in-current--from-grep)
                               (flatten-list))))
    (seq-uniq tags 'string-equal)))

(defun org-tags-in-current--from-grep (line)
  "Return a list of tags from LINE that match `org-find-files-tag-line-re'."
  (let ((case-fold-search t))
    (when (string-match org-find-files-tag-line-re line)
      (if-let ((s1 (match-string 1 line)))
          (split-string s1 ":")
        (if-let ((s2 (match-string 2 line)))
          (split-string s2 (rx (1+ space))))))))

(defun org-find-file-by-tags (file-tuple)
  "Load file from FILE-TUPLE like `find-file'.

If called interactively, first ask for a TAG and then limit the
files displayed based on if they have a headline that contains
that TAG."
  (interactive (list
                ;; The org-find-files-file-with-tag is a hash table where
                ;; the key is a user-visible entry, and the value is a
                ;; list of the filename and the (first) line number:
                (let ((files (call-interactively 'org-find-files-file-with-tag)))
                  (gethash (completing-read "File: " files) files))))

  (seq-let (file line) file-tuple
    (find-file file)
    (when line
      (goto-line line))))

(defun org-find-files-file-with-tag (tag &optional dir)
  "Return hashtable of files in project with headlines containing TAG."
  (interactive (list (completing-read "Tag: " (org-tags-in-current) nil t)))
  (unless dir
    (setq dir (file-truename (if (project-current)
                                 (project-root (project-current))
                               default-directory))))

  (let* ((tags-re (rx (or (seq "#+tags:" (0+ any) space (literal tag) word-boundary)
                          (seq (1+ "*") space (1+ any) ":" (literal tag) ":"))))
         (command (format "rg --ignore-case --no-heading --line-number '%s' %s"
                          (rxt-elisp-to-pcre tags-re) dir))
         (output  (shell-command-to-list command))
         (reducer (org-find-files--add-file-with-tag dir))
         (results (make-hash-table :test 'equal)))
    (reduce reducer output :initial-value results)
    results))

(defun org-find-files--add-file-with-tag (dir)
  "Return a reducer function with DIR available as lexical scope.
The function return is a reducer, accepting a hashtable as an accumulator,
and an entry from ripgrep. Assumes the entry looks like:

/home/howard/website/Technical/Emacs/org-find-file-tags.org:58:** What Tags do we have? :tags:

And crafts a key for display to the user, e.g.

     Technical/Emacs/org-find-file-tags.org :: What Tags do we have?

And the value is a list with the full filename as well as the
linenumber. For instance:

    (\"/home/howard/website/Technical/Emacs/org-find-file-tags.org\" 58)"
  (lambda (acc-hash rg-file-entry)
    (let ((line-re (rx (group (one-or-more (not ":"))) ":"
                       (group (one-or-more digit))     ":"
                       (or "#+tags:"
                           (seq
                            (one-or-more "*") (one-or-more space)
                            (group (+? (not ":")))
                            (one-or-more space) ":")))))
      (when (string-match line-re rg-file-entry)
        ;; Extract the grouped parts of the entry into variables:
        (let* ((fullfile (match-string 1 rg-file-entry))
               (linestr  (match-string 2 rg-file-entry))
               (heading  (or (match-string 3 rg-file-entry) ""))
               (linenum  (string-to-number linestr))
               ;; Prepare to store the key/value in the hashtable:
               (key      (format "%s %s"
                                 (string-trim (string-remove-prefix dir fullfile))
                                 (if (string-blank-p heading)  ""
                                   (concat ":: " heading))))
               (value    (list fullfile linenum)))
          (puthash key value acc-hash)))
      acc-hash)))

(provide 'org-find-file-tags)
;;; org-find-file-tags.el ends here
