(in-package :passepartout)

(defvar *archivist-last-scribe* 0
  "Universal time of the last Scribe distillation run.")

(defvar *archivist-last-gardener* 0
  "Universal time of the last Gardener scan run.")

(defvar *archivist-gardener-interval* 86400
  "Seconds between Gardener scans. Default: 24 hours.")

(defun archivist-scribe-distill ()
  "Distills daily log entries into atomic notes. Reads the Memex daily/
directory for log files modified since the last run, extracts headlines
as potential note seeds, and creates atomic note files in notes/ with
backlinks to the source daily entry."
  (let* ((memex-dir (or (uiop:getenv "MEMEX_DIR")
                        (namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
         (daily-dir (merge-pathnames "daily/" memex-dir))
         (notes-dir (merge-pathnames "notes/" memex-dir))
         (now (get-universal-time))
         (notes-created 0))
    (unless (uiop:directory-exists-p daily-dir)
      (log-message "ARCHIVIST: Daily directory not found: ~a" daily-dir)
      (return-from archivist-scribe-distill nil))
    (ensure-directories-exist notes-dir)
    (handler-case
        (let ((daily-files (uiop:directory-files daily-dir "*.org")))
          (dolist (file daily-files)
            (let* ((filepath (namestring file))
                   (file-mtime (ignore-errors (file-write-date filepath))))
              (when (and file-mtime (> file-mtime *archivist-last-scribe*))
                ;; Extract headlines from daily log
                (let* ((content (handler-case (uiop:read-file-string filepath)
                                  (error () nil)))
                       (headlines (when content
                                    (archivist-extract-headlines content))))
                  (dolist (hl headlines)
                    (when (archivist-create-note hl notes-dir filepath)
                      (incf notes-created))))))))
      (error (c)
        (log-message "ARCHIVIST: Scribe error: ~a" c)))
    (setf *archivist-last-scribe* now)
    (when (> notes-created 0)
      (log-message "ARCHIVIST: Scribe created ~d atomic notes" notes-created))
    notes-created))

(defun archivist-extract-headlines (content)
  "Extracts first-level headlines and their content from Org text.
Returns a list of plists: (:title <str> :content <str> :tags <list>)."
  (let ((lines (uiop:split-string content :separator '(#\Newline)))
        (results nil)
        (current-title nil)
        (current-lines nil)
        (current-tags nil)
        (in-properties nil))
    (dolist (line lines)
      (let ((trimmed (string-trim '(#\Space) line)))
        (when (string= trimmed ":PROPERTIES:")
          (setf in-properties t))
        (when (string= trimmed ":END:")
          (setf in-properties nil))
        (when (and in-properties (uiop:string-prefix-p ":TAGS:" trimmed))
          (setf current-tags
                (mapcar (lambda (tag) (string-trim '(#\Space) tag))
                        (uiop:split-string (string-trim '(#\Space) (subseq trimmed 6))
                                           :separator '(#\space #\tab)))))
        (cond
          ;; First-level headline
          ((and (uiop:string-prefix-p "* " trimmed)
                (not (uiop:string-prefix-p "**" trimmed)))
           ;; Save previous
           (when current-title
             (push (list :title current-title
                         :content (format nil "~{~a~^~%~}" (nreverse current-lines))
                         :tags current-tags)
                   results))
           (setf current-title (string-trim '(#\* #\Space) trimmed)
                 current-lines nil
                 current-tags nil
                 in-properties nil))
          ;; Content lines under current headline
          (current-title
           (unless (or (uiop:string-prefix-p "*" trimmed)
                       (string= trimmed ":PROPERTIES:")
                       (string= trimmed ":END:"))
             (push line current-lines))))))
    ;; Save last headline
    (when current-title
      (push (list :title current-title
                  :content (format nil "~{~a~^~%~}" (nreverse current-lines))
                  :tags current-tags)
            results))
    (nreverse results)))

(defun archivist-headline-to-filename (title)
  "Converts a headline title to a valid atomic note filename.
Replaces spaces and special chars with underscores, downcases."
  (let* ((clean (cl-ppcre:regex-replace-all "[^a-zA-Z0-9 ]" title ""))
         (underscored (cl-ppcre:regex-replace-all "\\s+" clean "_"))
         (lowered (string-downcase underscored)))
    (if (> (length lowered) 100)
        (subseq lowered 0 100)
        lowered)))

(defun archivist-create-note (headline notes-dir source-filepath)
  "Creates an atomic note from a headline plist in the notes/ directory.
Headline is a plist (:title <str> :content <str> :tags <list>).
Returns T if note was created, nil if it already exists."
  (let* ((title (getf headline :title))
         (content (or (getf headline :content) ""))
         (tags (getf headline :tags))
         (filename (archivist-headline-to-filename title))
         (filepath (merge-pathnames (format nil "~a.org" filename) notes-dir))
         (source-basename (enough-namestring source-filepath
                                             (merge-pathnames "" notes-dir))))
    (when (uiop:file-exists-p filepath)
      (return-from archivist-create-note nil))
    (handler-case
        (progn
          (uiop:with-output-file (s filepath :if-exists :nil)
            (format s "#+TITLE: ~a~%" title)
            (format s "#+FILETAGS: :atomic:note:~:[~;~{~a~^:~}~]~%" tags tags)
            (format s "~%* ~a~%" title)
            (format s ":PROPERTIES:~%")
            (format s ":CREATED: ~a~%" (org-id-generate))
            (format s ":SOURCE: ~a~%" source-basename)
            (format s ":END:~%")
            (format s "~%~a~%" content)
            (format s "~%* Backlinks~%")
            (format s "- Source: [[file:~a][~a]]~%" source-basename
                    (file-namestring source-filepath)))
          (log-message "ARCHIVIST: Created note ~a" (namestring filepath))
          t)
      (error (c)
        (log-message "ARCHIVIST: Failed to create note ~a: ~a" filepath c)
        nil))))

(defun archivist-gardener-scan ()
  "Scans the Memex for broken file links and orphaned memory objects.
Broken links are =[[file:...]]= references whose target file does not exist.
Orphaned objects are =memory-object= entries whose =:parent-id= references
a deleted object. Returns a plist (:broken-links <count> :orphans <count>)."
  (let* ((memex-dir (or (uiop:getenv "MEMEX_DIR")
                        (namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
         (org-files (archivist-find-org-files memex-dir))
         (broken-links 0)
         (orphans 0))
    ;; Scan for broken links
    (dolist (file org-files)
      (handler-case
          (let* ((content (uiop:read-file-string file))
                 (links (archivist-extract-file-links content)))
            (dolist (link links)
              (let ((target (merge-pathnames link (make-pathname :directory
                                  (pathname-directory file)))))
                (unless (uiop:file-exists-p target)
                  (log-message "ARCHIVIST: Broken link in ~a -> ~a"
                               (enough-namestring file memex-dir) link)
                  (incf broken-links)))))
        (error ()
          (log-message "ARCHIVIST: Could not read ~a" file))))
    ;; Scan for orphaned memory objects
    (handler-case
        (let ((deleted-ids (make-hash-table :test 'equal)))
          ;; In practice, we check if parent-id points to a non-existent object
          (maphash (lambda (id obj)
                     (declare (ignore obj))
                     (setf (gethash id deleted-ids) t))
                   (if (boundp '*memory-store*)
                       (symbol-value '*memory-store*)
                       (make-hash-table :test 'equal)))
          (let ((store (if (boundp '*memory-store*)
                           (symbol-value '*memory-store*)
                           (make-hash-table :test 'equal))))
            (maphash (lambda (id obj)
                       (let ((parent (memory-object-parent-id obj)))
                         (when (and parent (not (gethash parent store)))
                           (log-message "ARCHIVIST: Orphaned object ~a (parent ~a not found)"
                                        id parent)
                           (incf orphans))))
                     store)))
      (error ()
        (log-message "ARCHIVIST: Memory store not available for orphan scan")))
    (setf *archivist-last-gardener* (get-universal-time))
    (list :broken-links broken-links :orphans orphans)))

(defun archivist-find-org-files (memex-dir)
  "Recursively finds all .org files under memex-dir, up to 3 levels deep."
  (let ((files nil))
    (labels ((walk (dir depth)
               (when (and (uiop:directory-exists-p dir) (< depth 3))
                 (handler-case
                     (dolist (entry (uiop:subdirectories dir))
                       (walk entry (1+ depth)))
                   (error ()))
                 (handler-case
                     (dolist (file (uiop:directory-files dir "*.org"))
                       (push (namestring file) files))
                   (error ())))))
      (walk memex-dir 0))
    files))

(defun archivist-extract-file-links (content)
  "Extracts all =[[file:...]]= link targets from Org content.
Returns a list of link target strings."
  (let ((links nil))
    (cl-ppcre:do-register-groups (target)
        ("\\[\\[file:([^\\]]+)\\]\\[" content)
      (unless (search "::" target)  ;; skip internal anchors
        (pushnew target links :test #'string=)))
    ;; Also handle bare [[file:target]] links
    (cl-ppcre:do-register-groups (target)
        ("\\[\\[file:([^\\]]+)\\]\\]" content)
      (unless (search "::" target)
        (pushnew target links :test #'string=)))
    links))

(defun archivist-run (action context)
  "Runs the archivist maintenance cycle. Checks Scribe and Gardener schedules
and dispatches as needed. Called by the deterministic gate."
  (declare (ignore action context))
  (let ((now (get-universal-time)))
    ;; Scribe runs every 6 hours (21600 seconds)
    (when (>= (- now *archivist-last-scribe*) 21600)
      (ignore-errors (archivist-scribe-distill)))
    ;; Gardener runs every 24 hours
    (when (>= (- now *archivist-last-gardener*) *archivist-gardener-interval*)
      (ignore-errors
        (let ((result (archivist-gardener-scan)))
          (when (> (getf result :broken-links) 0)
            (log-message "ARCHIVIST: Gardener found ~d broken links, ~d orphans"
                         (getf result :broken-links) (getf result :orphans)))))))
  nil)

(defskill :passepartout-system-archivist
  :priority 100
  :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
  :deterministic #'archivist-run)