;;; full-gtd-core.el --- Core infrastructure for full-gtd  -*- lexical-binding: t; -*-

;; Copyright (C) 2026 OverbearingPearl
;; Author: OverbearingPearl <OverbearingPearl@outlook.com>
;; Assisted-by: Kimi:kimi-k2.5, DeepSeek:deepseek-v3.2, Claude:claude-sonnet-4.6
;; URL: https://github.com/OverbearingPearl/full-gtd
;; SPDX-License-Identifier: MIT

;;; Commentary:

;; Core infrastructure and thin delegation layer.
;; Predicates, filters, and data collection utilities.
;; File operation macros delegate to full-gtd-state.
;; Data normalization functions delegate to full-gtd-domain.

;;; Code:

(require 'org)
(require 'org-element)
(require 'crm)  ;; completing-read-multiple
(require 'full-gtd-init)
(require 'full-gtd-domain)
(require 'full-gtd-state)

;;;; Predicates

(defun full-gtd-core-entry-todo-p ()
  "Return non-nil if current entry is a TODO item."
  (let ((state (org-get-todo-state)))
    (member state org-not-done-keywords)))

(defun full-gtd-core-entry-done-p ()
  "Return non-nil if current entry is a DONE item."
  (member (org-get-todo-state) org-done-keywords))

(defun full-gtd-core-entry-scheduled-today-p ()
  "Return non-nil if current entry is scheduled for today."
  (let* ((scheduled (org-entry-get nil "SCHEDULED"))
         (ct (current-time))
         (today-pattern (format-time-string "<%F" ct)))
    (and scheduled
         (string-match-p today-pattern scheduled))))

(defun full-gtd-core-entry-completed-today-p ()
  "Return non-nil if current entry was closed today."
  (let* ((closed (org-entry-get nil "CLOSED")))
    (and closed
         (string-match-p (format-time-string "\\[%F" (current-time)) closed))))

(defun full-gtd-core-entry-delegated-p ()
  "Return non-nil if current entry is delegated."
  (org-entry-get nil "DELEGATED"))

(defun full-gtd-core-entry-overdue-p ()
  "Return non-nil if current entry is overdue."
  (let ((scheduled (org-entry-get nil "SCHEDULED")))
    (and scheduled (time-less-p (org-time-string-to-time scheduled) (current-time)))))

(defun full-gtd-core--default-todo-keyword ()
  "Return the first not-done TODO keyword, or \"TODO\" if none."
  (or (car org-not-done-keywords) "TODO"))

;;;; Filters

(defun full-gtd-core-filter-entries (file-path predicates)
  "Filter entries in FILE-PATH using PREDICATES.
PREDICATES is a list of predicate functions to apply.
Each predicate is called with no arguments in the context of the entry.
Return list of entries that pass all predicates.
Entries are lists:
\(HEADLINE TAGS-STRING TODO-STATE SCHEDULED DELEGATED PROJECT CREATED
  ID FILE DEADLINE CONTEXT L3_AREA L4_GOAL L5_VISION L6_PURPOSE).
Nil values indicate unset properties."
  (let ((entries '())
        (file-name (file-name-nondirectory file-path)))
    (when (file-exists-p file-path)
      (with-temp-buffer
        (insert-file-contents file-path)
        (org-mode)
        (org-map-entries
         (lambda ()
           (when (cl-every (lambda (pred) (funcall pred)) predicates)
             (let* ((head (org-get-heading t t))
                    (id (org-entry-get nil "ID"))
                    (tags (org-get-tags))
                    (todo-state (org-get-todo-state))
                    (scheduled (org-entry-get nil "SCHEDULED"))
                    (deadline (org-entry-get nil "DEADLINE"))
                    (delegated (org-entry-get nil "DELEGATED"))
                    (project (org-entry-get nil "PROJECT"))
                    (created (org-entry-get nil "CREATED"))
                    (context (mapconcat (lambda (c) (concat "@" c)) tags ","))
                    (l3 (org-entry-get nil "L3_AREA"))
                    (l4 (org-entry-get nil "L4_GOAL"))
                    (l5 (org-entry-get nil "L5_VISION"))
                    (l6 (org-entry-get nil "L6_PURPOSE")))
               (when id
                 (put-text-property 0 (length head) 'full-gtd-id id head))
               (push (list head
                           (mapconcat (lambda (c) (concat "@" c)) tags ",")
                           todo-state
                           scheduled
                           delegated
                           project
                           created
                           id
                           file-name
                           deadline
                           context
                           l3
                           l4
                           l5
                           l6)
                     entries))))
         nil nil)))
    (nreverse entries)))

;;;; Data Collection

(defun full-gtd-core-collect-contexts (file-path)
  "Collect all unique context tags from FILE-PATH."
  (let ((contexts '()))
    (when (file-exists-p file-path)
      (with-temp-buffer
        (insert-file-contents file-path)
        (org-mode)
        (org-map-entries
         (lambda ()
           (when (member (org-get-todo-state) org-not-done-keywords)
             (dolist (tag (org-get-tags))
               (cl-pushnew tag contexts :test #'string=))))
         nil nil)))
    (mapcar (lambda (c) (concat "@" c)) contexts)))

;;;; Macros for file operations

(defmacro full-gtd-core-with-entry-at-id (id file &rest body)
  "Execute BODY with point at entry ID in FILE.
Delegate to state layer for transactional file operations."
  (declare (indent 2))
  `(full-gtd-state--with-entry-at-id ,id ,file ,@body))

(defun full-gtd-core-read-date (prompt-type)
  "Hybrid date input for PROMPT-TYPE: letter=quick, number=free-form, RET=skip.
PROMPT-TYPE is \\='schedule or \\='deadline for display.
Quick keys: t (today), T (tomorrow), w (week), h (hour, schedule only).
Returns date string or nil if skipped.
Signals \\='quit if user presses \\`C-g\\'."
  (catch 'done
    (let (result)
      (while (not result)
        (if (eq prompt-type 'schedule)
            (message "[Schedule] Quick: [t]oday, [T]omorrow, [w]eek, [h]our | Custom: <YYYY-MM-DD> or <YYYY-MM-DD HH:MM> | [RET] Skip: ")
          (message "[Deadline] Quick: [t]oday, [T]omorrow, [w]eek | Custom: <YYYY-MM-DD> | [RET] Skip: "))
        (let ((key (read-key)))
          (cond
           ((eq key ?t) (setq result (format-time-string "%F")))
           ((eq key ?T) (setq result (format-time-string "%F" (time-add (current-time) (* 24 3600)))))
           ((eq key ?w) (setq result (format-time-string "%F" (time-add (current-time) (* 7 24 3600)))))
           ((and (eq prompt-type 'schedule) (eq key ?h))
            (setq result (format-time-string "%F %R" (time-add (current-time) 3600))))
           ((eq key ?\r) (throw 'done nil))
           ((and (>= key ?0) (<= key ?9))
            (condition-case nil
                (let ((full (minibuffer-with-setup-hook
                                (lambda () (select-window (minibuffer-window)))
                              (read-string (format "%s (e.g., 2023-12-25 or 2023-12-25 14:30): " prompt-type)
                                           (string key) nil nil))))
                  (if (string-match-p "^[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: [0-2][0-9]:[0-5][0-9]\\)?$" full)
                      (setq result full)
                    (message "Invalid date, retry") (sit-for 0.5)))
              (quit (signal 'quit nil))))
           ((eq key 7)
            (signal 'quit nil))
           (t (message "Invalid key") (sit-for 0.5)))))
      result)))

(defun full-gtd-core--split-values (value-string)
  "Split VALUE-STRING using semicolon separator.
Supports both English (;) and Chinese (；) semicolons.
Trim whitespace from each value.  Filter empty values.
Example: \"Project A; Project B；Project C\"
  -> (\"Project A\" \"Project B\" \"Project C\")
Delegate to domain layer for pure computation."
  (full-gtd-domain--split-values value-string))

(defun full-gtd-core--join-values (values)
  "Join VALUES list using English semicolon separator.
Always uses English semicolon for storage consistency.
Example: (\"Project A\" \"Project B\") -> \"Project A; Project B\"
Delegate to domain layer for pure computation."
  (full-gtd-domain--join-values values))

(defun full-gtd-core--normalize-project-input (input)
  "Normalize project input: convert Chinese semicolons to English.
Trim whitespace from each value.  Returns nil if empty.
INPUT is the input string to normalize.
Example: \"Project A；Project B；Project C\"
  -> \"Project A; Project B; Project C\"
Delegate to domain layer for pure computation."
  (full-gtd-domain--normalize-project-input input))

;;;; Unified property reading with completion

(defun full-gtd-core-read-property-with-completion (prompt property-type &optional initial)
  "Read property value with completion.
PROMPT is the prompt string displayed to the user.
PROPERTY-TYPE: context/project/delegate/l3/l4/l5/l6/principle.
INITIAL is the optional initial value string.
Project and horizons (L3-L6) support multiple values separated by semicolon."
  (let* ((candidates (pcase property-type
                       ('context (full-gtd-domain--collect-context-candidates))
                       ('project (full-gtd-domain--collect-project-candidates))
                       ('delegate (full-gtd-domain--collect-delegate-candidates))
                       ('l3 (full-gtd-domain--collect-horizon-candidates "L3_AREA"))
                       ('l4 (full-gtd-domain--collect-horizon-candidates "L4_GOAL"))
                       ('l5 (full-gtd-domain--collect-horizon-candidates "L5_VISION"))
                       ('l6 (full-gtd-domain--collect-horizon-candidates "L6_PURPOSE"))
                       ('principle (full-gtd-domain--collect-horizon-candidates "L6_PRINCIPLE"))
                       (_ (error "Unknown property type: %s" property-type))))
         (is-multi-value (member property-type '(project l3 l4 l5 l6 principle))))

    (if is-multi-value
        (let* ((crm-separator "[;；]\\s-*")
               (initial-input
                (when initial
                  (full-gtd-domain--join-values
                   (full-gtd-domain--split-values initial))))
               (values (completing-read-multiple prompt candidates nil nil initial-input)))
          (if values
              (full-gtd-domain--join-values values)
            ""))
      (string-trim (completing-read prompt candidates nil nil initial)))))

;;;; Notes (body) manipulation

(defun full-gtd-core--entry-notes-bounds ()
  "Return (BEGIN . END) of current entry's notes area.
Notes area runs from after meta data to before first child heading
or next sibling heading."
  (save-excursion
    (org-back-to-heading)
    (let* ((element (org-element-at-point))
           (entry-end (or (org-element-property :end element)
                          (progn (org-end-of-subtree) (point))))
           (contents (and (eq (org-element-type element) 'headline)
                          (org-element-contents element)))
           (drawer (and contents
                        (cl-find-if (lambda (child)
                                      (eq (org-element-type child) 'property-drawer))
                                    contents)))
           (raw-begin (or (and drawer (org-element-property :end drawer))
                          (progn (org-end-of-meta-data t) (point))))
           ;; Find literal `:END:` line even if drawer is malformed
           ;; because a trailing character on the :END: line makes it
           ;; unrecognised by `org-element'.
           (end-pos (save-excursion
                      (goto-char (org-entry-beginning-position))
                      (and (re-search-forward "^:END:" entry-end t)
                           (match-end 0))))
           (begin (cond
                   ;; If there is text after the `:END:' marker on the
                   ;; same line, treat that text as part of the notes
                   ;; area.  The unprocessed leading character lets
                   ;; `set-entry-notes' remove it later.
                   ((and end-pos (char-after end-pos)
                         (not (memq (char-after end-pos) '(?\n ?\r))))
                    end-pos)
                   ;; Otherwise use the standard property-drawer end,
                   ;; which already points just past the newline.
                   (t raw-begin)))
           (section (and contents
                         (cl-find-if (lambda (child)
                                       (eq (org-element-type child) 'section))
                                     contents)))
           (section-end (and section
                             (let ((se (org-element-property :end section)))
                               (when (> se begin) se))))
           (end (or section-end
                    (save-excursion
                      (goto-char begin)
                      (let ((pos (and (re-search-forward "^\\*+[ \t]" entry-end t)
                                      (match-beginning 0))))
                        (or pos entry-end))))))
      (when (and begin end)
        ;; When there is no visible notes content (e.g., empty body with
        ;; immediate sibling), ensure we still return a non-empty region
        ;; that contains the separating newline.
        (when (<= end begin)
          (if (> begin (point-min))
              (setq begin (1- begin))
            (setq end (1+ end))))
        (when (< begin end)
          (cons begin end))))))

(defun full-gtd-core--get-entry-notes ()
  "Return current entry's notes (body) as string, or nil if empty."
  (let ((bounds (full-gtd-core--entry-notes-bounds)))
    (when bounds
      (let ((text (buffer-substring-no-properties (car bounds) (cdr bounds))))
        (setq text (string-trim text))
        (unless (string= text "") text)))))

(defun full-gtd-core--set-entry-notes (text)
  "Replace current entry's notes (body) with TEXT.
If TEXT is empty, delete all notes."
  (let ((bounds (full-gtd-core--entry-notes-bounds)))
    (when bounds
      (let ((begin (car bounds))
            (end (cdr bounds))
            (new-text (if (string= text "") nil text)))
        (goto-char begin)
        (delete-region begin end)
        (when new-text
          ;; Ensure notes start on a new line after meta data.
          (unless (or (bobp) (eq (char-before) ?\n))
            (insert "\n"))
          (insert new-text "\n"))))))

(defun full-gtd-core--edit-entry-notes ()
  "Edit current entry's notes using `read-string'."
  (let* ((old (full-gtd-core--get-entry-notes))
         (new (string-trim (read-string "Notes (empty to clear, use C-q C-j for newline): "
                                        (or old "")))))
    (full-gtd-core--set-entry-notes new)))

(provide 'full-gtd-core)

;;; full-gtd-core.el ends here
