;;; lint-org.el --- org-lint sweeper for tracked org files  -*- lexical-binding: t; -*-
;;
;; Usage:
;;   emacs --batch -q -l lint-org.el FILE.org [FILE.org ...]
;;     apply mechanical fixes in place, emit judgment items on stdout for the
;;     command layer to walk
;;
;;   emacs --batch -q -l lint-org.el --check FILE.org [FILE.org ...]
;;     report only — categorize without modifying the file
;;
;;   emacs --batch -q -l lint-org.el --followups-file=PATH FILE.org
;;     apply mechanical fixes; if any judgment items remain, append them to
;;     PATH as an org section dated today.  Used by wrap-it-up to defer the
;;     judgment walk to the next morning's review without blocking the wrap.
;;
;; Mechanical categories (auto-fixed):
;;   item-number                       add [@N] directive to drifted bullets
;;   missing-language-in-src-block     convert bare #+begin_src to #+begin_example
;;   misplaced-planning-info           merge multi-line CLOSED:/DEADLINE:/SCHEDULED:
;;   misplaced-heading (markdown-bold) **X.** at start of line → *X.*
;;
;; Judgment categories (emitted on stdout):
;;   misplaced-heading (verbatim-*)    =*** Foo= inside body prose
;;   link-to-local-file                broken file: links
;;   invalid-fuzzy-link                broken *Heading refs
;;   suspicious-language-in-src-block  unknown source-block language
;;   (anything else)                   surfaced as judgment with checker name
;;
;; Output format on stdout:
;;   first line:  ;; lint-org: file=<path> mechanical=<N>[ (would-fix)] judgment=<M>
;;   each issue:  (:kind mechanical-fixed|judgment :line <N> :checker <symbol> :msg "..." [:preview t])
;;
;; Before modifying a file, a backup is copied to
;;   /tmp/<basename>.before-lint-pass.<YYYYMMDD-HHMMSS>

(require 'org)
(require 'org-lint)
(require 'cl-lib)
(require 'subr-x)

(defvar lo-fixes 0
  "Count of mechanical fixes applied (or would-apply in --check) on the last file.")
(defvar lo-issues nil
  "Reverse-document-order list of plists describing each issue from the last file.
Each plist has :kind (mechanical-fixed | judgment), :line, :checker, :msg.
Mechanical entries from --check mode also carry :preview t.")
(defvar lo-check-only nil
  "Non-nil means run in report-only mode — no buffer writes.")
(defvar lo-current-file nil
  "Path of the file currently being processed.")
(defvar lo-followups-file nil
  "When non-nil, after a non-check run any judgment items are appended to this
path as an org section dated today.  The file is created if missing.")

(defconst lo-mechanical-checkers
  '(item-number missing-language-in-src-block misplaced-planning-info)
  "org-lint checker names that are always treated as mechanical.")

;; misplaced-heading is split case-by-case (markdown-bold vs verbatim-asterisk)
;; in `lo--handle-item'.

;;; ---------------------------------------------------------------------------
;;; org-lint result accessors

(defun lo--checker-name (item)
  "Return the checker symbol name for ITEM."
  (let* ((vec (cadr item))
         (checker (aref vec 3)))
    (org-lint-checker-name checker)))

(defun lo--line (item)
  "Return the 1-based line number for ITEM."
  (let* ((vec (cadr item))
         (marker-str (aref vec 0)))
    (string-to-number (substring-no-properties marker-str))))

(defun lo--message (item)
  "Return the human-readable message for ITEM."
  (let ((vec (cadr item))) (aref vec 2)))

;;; ---------------------------------------------------------------------------
;;; Mechanical fixers — each runs against the current buffer, returns
;;; non-nil on success, nil if its preconditions don't hold (already
;;; fixed, unexpected shape, etc.).

(defun lo--goto-line (line)
  (goto-char (point-min))
  (forward-line (1- line)))

(defun lo-fix-item-number (line)
  "Insert an [@N] counter on the bullet at LINE, derived from its leading number."
  (save-excursion
    (lo--goto-line line)
    (when (looking-at "^[ \t]*\\([0-9]+\\)[.)]\\([ \t]+\\)")
      (let ((num (match-string 1)))
        (goto-char (match-end 0))
        (unless (looking-at "\\[@")
          (insert (format "[@%s] " num))
          t)))))

(defun lo-fix-missing-language (line)
  "Convert a bare `#+begin_src` block starting at LINE to `#+begin_example`.
Locates the matching `#+end_src` directly below and rewrites it too."
  (save-excursion
    (lo--goto-line line)
    (when (looking-at "^\\([ \t]*\\)#\\+begin_src[ \t]*$")
      (let* ((indent (match-string 1))
             (begin-bol (line-beginning-position))
             (begin-eol (line-end-position))
             ;; case-fold the end keyword search to match org's tolerance
             (end-re (format "^%s#\\+end_src[ \t]*$" (regexp-quote indent))))
        (delete-region begin-bol begin-eol)
        (insert (format "%s#+begin_example" indent))
        (forward-line 1)
        (when (re-search-forward end-re nil t)
          (replace-match (format "%s#+end_example" indent) t t)
          t)))))

(defun lo-fix-misplaced-planning (line)
  "Collapse all planning lines under the heading containing LINE into a single
canonical line right after the heading, ordered CLOSED → DEADLINE → SCHEDULED.
LINE positions the search start — the fixer then rebuilds the whole entry's
planning block at once, so it does the right thing whether the misplaced line
is the first, last, or middle of the run."
  (save-excursion
    (lo--goto-line line)
    (when (re-search-backward "^\\*+ " nil t)
      (let* ((heading-bol (line-beginning-position))
             (body-start (progn (forward-line 1) (point)))
             (entry-end (save-excursion (outline-next-heading) (point)))
             (parts nil)
             (ranges nil))
        (goto-char body-start)
        (while (re-search-forward
                "^[ \t]*\\(CLOSED\\|DEADLINE\\|SCHEDULED\\):.*$"
                entry-end t)
          (let* ((line-bol (match-beginning 0))
                 (line-eol (match-end 0))
                 (content (buffer-substring-no-properties line-bol line-eol))
                 (pos 0))
            (while (string-match
                    "\\(CLOSED\\|DEADLINE\\|SCHEDULED\\):[ \t]*\\(\\[[^]]+\\]\\|<[^>]+>\\)"
                    content pos)
              (push (cons (match-string 1 content)
                          (match-string 2 content))
                    parts)
              (setq pos (match-end 0)))
            ;; Record line-bol .. line-eol+1 so the trailing newline goes too.
            (push (cons line-bol (min (1+ line-eol) (point-max))) ranges)))
        (when (> (length parts) 1)
          (let* ((order '("CLOSED" "DEADLINE" "SCHEDULED"))
                 (deduped (cl-remove-duplicates (nreverse parts) :test #'equal))
                 (sorted (sort deduped
                               (lambda (a b)
                                 (< (or (cl-position (car a) order :test #'string=) 99)
                                    (or (cl-position (car b) order :test #'string=) 99)))))
                 (merged (mapconcat (lambda (p) (format "%s: %s" (car p) (cdr p)))
                                    sorted " ")))
            (dolist (r (sort (copy-sequence ranges)
                             (lambda (a b) (> (car a) (car b)))))
              (delete-region (car r) (cdr r)))
            (goto-char heading-bol)
            (forward-line 1)
            (insert merged "\n")
            t))))))

(defun lo--find-markdown-bold-line (reported-line)
  "Return the actual line number containing a leading `**X**` near REPORTED-LINE.
org-lint's marker for misplaced-heading typically points at the blank line
following the offender, so check (REPORTED-LINE - 1) before REPORTED-LINE.
Returns nil if no nearby line matches the markdown-bold pattern."
  (save-excursion
    (cl-loop for candidate in (list (1- reported-line) reported-line)
             when (and (>= candidate 1)
                       (progn (lo--goto-line candidate)
                              (looking-at "^\\*\\*[^*\n]+\\*\\*")))
             return candidate)))

(defun lo--markdown-bold-at-line-p (line)
  "Non-nil if LINE (or LINE - 1) looks like a markdown-bold case of
misplaced-heading.  Pattern: `**X**` at the start of the line, X a short prose
run without asterisks."
  (and (lo--find-markdown-bold-line line) t))

(defun lo-fix-markdown-bold (line)
  "Convert a leading `**X**` near LINE to `*X*` (org single-asterisk bold).
Uses `lo--find-markdown-bold-line' to locate the actual offender, since
org-lint reports the blank line after the heading-like text."
  (let ((actual (lo--find-markdown-bold-line line)))
    (when actual
      (save-excursion
        (lo--goto-line actual)
        (when (looking-at "^\\(\\*\\*\\)\\([^*\n]+\\)\\(\\*\\*\\)")
          (let ((start (match-beginning 0))
                (end (match-end 0))
                (inner (match-string 2)))
            (delete-region start end)
            (goto-char start)
            (insert (format "*%s*" inner))
            t))))))

;;; ---------------------------------------------------------------------------
;;; Per-item dispatch

(defun lo--emit-judgment (name line msg)
  (push (list :kind 'judgment :line line :checker name :msg msg)
        lo-issues))

(defun lo--apply-or-preview (name line msg fixer)
  (cond
   (lo-check-only
    (cl-incf lo-fixes)
    (push (list :kind 'mechanical-fixed :line line :checker name :msg msg
                :preview t)
          lo-issues))
   ((funcall fixer line)
    (cl-incf lo-fixes)
    (push (list :kind 'mechanical-fixed :line line :checker name :msg msg)
          lo-issues))
   (t
    ;; Fixer declined — emit as judgment so nothing is silently swallowed.
    (lo--emit-judgment name line msg))))

(defun lo--cj-comment-block-opener-p (line)
  "Non-nil when LINE in the current buffer is a `#+begin_src cj: ...' opener.
The cj-comment annotation convention puts `cj:' as the src-block language and
`comment' as the apparent header arg.  org-lint reads that shape three ways
(unknown language, empty header-arg value, missing colon in header arg) and
flags each — all three are false positives, since cj-comment is a
Craig-specific annotation marker rather than Babel src-block syntax."
  (save-excursion
    (lo--goto-line line)
    (looking-at-p "^[ \t]*#\\+begin_src[ \t]+cj:")))

(defun lo--handle-item (item)
  (let ((name (lo--checker-name item))
        (line (lo--line item))
        (msg (lo--message item)))
    (cond
     ;; Silent suppression of cj-comment false positives — see
     ;; `lo--cj-comment-block-opener-p'.  No fix counted, no judgment emitted.
     ((and (memq name '(suspicious-language-in-src-block
                        empty-header-argument
                        wrong-header-argument))
           (lo--cj-comment-block-opener-p line))
      nil)
     ((eq name 'item-number)
      (lo--apply-or-preview name line msg #'lo-fix-item-number))
     ((eq name 'missing-language-in-src-block)
      (lo--apply-or-preview name line msg #'lo-fix-missing-language))
     ((eq name 'misplaced-planning-info)
      (lo--apply-or-preview name line msg #'lo-fix-misplaced-planning))
     ((eq name 'misplaced-heading)
      (if (lo--markdown-bold-at-line-p line)
          (lo--apply-or-preview name line msg #'lo-fix-markdown-bold)
        (lo--emit-judgment name line msg)))
     (t
      (lo--emit-judgment name line msg)))))

;;; ---------------------------------------------------------------------------
;;; File processing

(defun lo--backup (file)
  "Copy FILE to /tmp before any modification.  Skipped in --check mode."
  (let ((backup (format "/tmp/%s.before-lint-pass.%s"
                        (file-name-nondirectory file)
                        (format-time-string "%Y%m%d-%H%M%S"))))
    (copy-file file backup t)
    backup))

(defun lo-process-file (file)
  "Run org-lint against FILE, apply mechanical fixes, collect judgment items.
Resets `lo-fixes' and `lo-issues' for each call.  In --check mode the file is
left unmodified and mechanical entries are recorded with :preview t."
  (setq lo-current-file file lo-fixes 0 lo-issues nil)
  (unless lo-check-only
    (lo--backup file))
  (let ((buf (find-file-noselect file)))
    (unwind-protect
        (with-current-buffer buf
          (revert-buffer t t t)
          (let* ((report (org-lint))
                 ;; Descending line order: applying a fix that adds/removes
                 ;; lines doesn't perturb the line numbers of items at smaller
                 ;; line numbers that haven't been processed yet.
                 (sorted (sort (copy-sequence report)
                               (lambda (a b) (> (lo--line a) (lo--line b))))))
            (dolist (item sorted)
              (lo--handle-item item)))
          (when (and (not lo-check-only) (buffer-modified-p))
            (save-buffer)))
      (with-current-buffer buf (set-buffer-modified-p nil))
      (kill-buffer buf))))

;;; ---------------------------------------------------------------------------
;;; Reporting

(defun lo--append-followups ()
  "Append any judgment items from the current run to `lo-followups-file' as a
dated org section.  No-op when the file path is unset or there are no
judgment items."
  (when lo-followups-file
    (let ((judgments (cl-remove-if-not
                      (lambda (i) (eq (plist-get i :kind) 'judgment))
                      (reverse lo-issues))))
      (when judgments
        (let ((dir (file-name-directory (expand-file-name lo-followups-file))))
          (when dir (make-directory dir t)))
        (with-temp-buffer
          (insert (format "\n* %s lint-org follow-ups — %s\n"
                          (format-time-string "%Y-%m-%d")
                          (file-name-nondirectory lo-current-file)))
          (dolist (i judgments)
            (insert (format "** TODO line %d — %s — %s\n"
                            (plist-get i :line)
                            (plist-get i :checker)
                            (plist-get i :msg))))
          (append-to-file (point-min) (point-max) lo-followups-file))))))

(defun lo-emit-report ()
  "Print the per-file summary line plus each issue as a readable plist.
After printing, also append judgments to `lo-followups-file' when set."
  (let ((mech (cl-count-if (lambda (i) (eq (plist-get i :kind) 'mechanical-fixed))
                           lo-issues))
        (judg (cl-count-if (lambda (i) (eq (plist-get i :kind) 'judgment))
                           lo-issues)))
    (princ (format ";; lint-org: file=%s mechanical=%d%s judgment=%d%s\n"
                   lo-current-file mech
                   (if lo-check-only " (would-fix)" "")
                   judg
                   (if (and lo-followups-file (> judg 0))
                       (format " followups=%s" lo-followups-file)
                     "")))
    (dolist (i (reverse lo-issues))
      (princ (format "%S\n" i)))
    (unless lo-check-only
      (lo--append-followups))))

;;; ---------------------------------------------------------------------------
;;; CLI

(defun lo-main ()
  (when (member "--check" command-line-args-left)
    (setq lo-check-only t)
    (setq command-line-args-left (delete "--check" command-line-args-left)))
  (let ((followups (cl-find-if
                    (lambda (a) (string-prefix-p "--followups-file=" a))
                    command-line-args-left)))
    (when followups
      (setq lo-followups-file (substring followups (length "--followups-file=")))
      (setq command-line-args-left (delete followups command-line-args-left))))
  (if (null command-line-args-left)
      (progn
        (princ "Usage: emacs --batch -q -l lint-org.el [--check] [--followups-file=PATH] FILE.org ...\n")
        (kill-emacs 1))
    (let ((files command-line-args-left))
      (setq command-line-args-left nil)
      (dolist (file files)
        (if (file-readable-p file)
            (progn
              (lo-process-file file)
              (lo-emit-report))
          (princ (format ";; lint-org: file=%s not readable — skipping\n"
                         file)))))))

(defun lo--cli-invocation-p ()
  "Non-nil when the trailing command-line arguments look like a real invocation:
only recognized flags and/or readable file paths.  Lets the ERT suite `require'
this file without firing the CLI dispatch — under `ert-run-tests-batch-and-exit'
the trailing args are things like `-f ert-run-tests-batch-and-exit'."
  (and command-line-args-left
       (cl-every (lambda (a)
                   (cond ((member a '("--check")) t)
                         ((string-prefix-p "--followups-file=" a) t)
                         ((string-prefix-p "-" a) nil)
                         (t (file-readable-p a))))
                 command-line-args-left)))

(when (and noninteractive (lo--cli-invocation-p))
  (lo-main))

(provide 'lint-org)
;;; lint-org.el ends here