(defun org-tangle-file (filepath)
  "Tangles an Org file's lisp blocks to its :tangle target, compiles, and loads."
  (let ((content (uiop:read-file-string filepath))
        (tangle-path nil)
        (lisp-lines nil)
        (in-block nil))
    (dolist (line (uiop:split-string content :separator '(#\Newline)))
      (let ((trimmed (string-trim '(#\Space #\Tab) line)))
        (cond
          ((and (null tangle-path)
                (search "#+PROPERTY:" trimmed)
                (search ":tangle" trimmed))
           (let* ((parts (uiop:split-string trimmed :separator '(#\Space)))
                  (target (car (last parts)))
                  (org-dir (make-pathname :directory (pathname-directory filepath))))
             (when (and target (not (string-equal target "no")))
               (setf tangle-path
                     (if (char= (aref target 0) #\/)
                         (uiop:parse-unix-namestring target)
                         (uiop:parse-unix-namestring
                          (format nil "~a/~a" (namestring org-dir) target)))))))
          ((search "#+begin_src lisp" trimmed)
           (setf in-block t))
          ((search "#+end_src" trimmed)
           (setf in-block nil)
           (let ((before (search "#+end_src" line)))
             (when (and before (> before 0))
               (push (subseq line 0 before) lisp-lines))))
          (in-block
           (push line lisp-lines)))))
    (when (and tangle-path lisp-lines)
      (setf lisp-lines (nreverse lisp-lines))
      (ensure-directories-exist tangle-path)
      (with-open-file (f tangle-path :direction :output :if-exists :supersede)
        (format f "~{~a~%~}" lisp-lines))
      (let ((compiled (compile-file tangle-path)))
        (when compiled
          (load compiled)
          (list :tangled (namestring tangle-path) :compiled t))))))

(defun org-extract-lisp-blocks (content)
  "Extracts all #+begin_src lisp blocks from Org CONTENT as a list of strings."
  (let ((blocks nil)
        (in-block nil)
        (current nil))
    (dolist (line (uiop:split-string content :separator '(#\Newline)))
      (let ((trimmed (string-trim '(#\Space #\Tab) line)))
        (cond
          ((search "#+begin_src lisp" trimmed)
           (setf in-block t current nil))
          ((search "#+end_src" trimmed)
           (when in-block
             (let ((before (search "#+end_src" line)))
               (when (and before (> before 0))
                 (push (subseq line 0 before) current)))
             (push (format nil "~{~a~%~}" (nreverse current)) blocks)
             (setf in-block nil current nil)))
          (in-block
           (push line current)))))
    (nreverse blocks)))

(defun self-improve-edit (filepath old-text new-text)
  "Surgical text replacement with tangle+reload for Org source files."
  (when (or (null filepath) (null old-text) (null new-text))
    (return-from self-improve-edit
      (list :status :error :reason "Missing arguments")))
  (when (not (uiop:file-exists-p filepath))
    (return-from self-improve-edit
      (list :status :error :reason (format nil "File not found: ~a" filepath))))
  (log-message "SELF-IMPROVE: Editing ~a (~d chars)" filepath (length old-text))
  (ignore-errors
    (when (fboundp 'snapshot-memory)
      (snapshot-memory)))
  (let* ((content (uiop:read-file-string filepath))
         (pos (search old-text content)))
    (if pos
        (let* ((new-content (concatenate 'string
                              (subseq content 0 pos)
                              new-text
                              (subseq content (+ pos (length old-text)))))
               (ext (pathname-type filepath)))
          (with-open-file (f filepath :direction :output :if-exists :supersede)
            (write-sequence new-content f))
          (let ((re-read (uiop:read-file-string filepath)))
            (if (search new-text re-read :test 'string=)
                (let ((tangle-result
                        (when (string-equal ext "org")
                          (ignore-errors (org-tangle-file filepath)))))
                  (list :status :success
                        :summary (format nil "Replaced ~d chars in ~a"
                                         (length old-text) filepath)
                        :tangle tangle-result))
                (list :status :error :reason "Verification failed"))))
        (list :status :error :reason
              (format nil "Text not found in ~a" filepath)))))

(defun self-improve-balance-parens (code)
  "Returns balanced code or nil if already balanced."
  (handler-case
      (progn
        (let ((*read-eval* nil))
          (with-input-from-string (s code)
            (loop for form = (read s nil :eof) until (eq form :eof)))
          (values))
        nil)
    (error ()
      (let* ((opens (loop for ch across code count (char= ch #\()))
             (closes (loop for ch across code count (char= ch #\))))
             (missing (- opens closes)))
        (when (plusp missing)
          (concatenate 'string code
                       (make-string missing :initial-element #\))))))))

(defun self-improve-repair-syntax (skill-name)
  "Find and fix unbalanced parens in a skill's Org source file."
  (let* ((data-dir (uiop:ensure-directory-pathname
                    (or (uiop:getenv "PASSEPARTOUT_DATA_DIR")
                        (merge-pathnames ".local/share/passepartout/"
                                         (user-homedir-pathname)))))
         (org-path (merge-pathnames (format nil "org/~a.org" skill-name) data-dir)))
    (unless (uiop:file-exists-p org-path)
      (return-from self-improve-repair-syntax
        (list :status :error :reason (format nil "Source not found: ~a" skill-name)
              :repaired nil)))
    (let* ((content (uiop:read-file-string org-path))
           (blocks (org-extract-lisp-blocks content))
           (fixed 0) (result content))
      (dolist (block blocks)
        (let ((balanced (self-improve-balance-parens block)))
          (when (and balanced (not (string= block balanced)))
            (let ((pos (search block result)))
              (when pos
                (setf result (concatenate 'string
                              (subseq result 0 pos)
                              balanced
                              (subseq result (+ pos (length block))))
                      fixed (1+ fixed)))))))
      (if (> fixed 0)
          (progn
            (with-open-file (f org-path :direction :output :if-exists :supersede)
              (write-sequence result f))
            (let ((tangle-result (org-tangle-file org-path)))
              (list :status :success
                    :action (format nil "Fixed ~d block(s) in ~a" fixed skill-name)
                    :repaired t :tangle tangle-result)))
          (list :status :error
                :reason (format nil "No unbalanced blocks in ~a" skill-name)
                :repaired nil)))))

(defun self-improve-fix (skill-name error-log)
  "Diagnoses and attempts to repair a failing skill."
  (when (or (null skill-name) (null error-log))
    (return-from self-improve-fix
      (list :status :error :reason "Missing arguments: skill-name and error-log required")))
  (log-message "SELF-IMPROVE: Diagnosing ~a..." skill-name)
  (let* ((log-str (if (stringp error-log) error-log (format nil "~a" error-log)))
         (diagnosis nil)
         (extracted-type nil))
    (cond
      ((search "Reader Error" log-str :test 'char-equal)
       (setf extracted-type :syntax-error
             diagnosis (list :type :syntax-error
                            :detail "Reader Error (likely unbalanced parentheses)"
                            :log log-str)))
      ((search "Undefined" log-str :test 'char-equal)
       (setf extracted-type :undefined-symbol
             diagnosis (list :type :undefined-symbol
                            :detail "Undefined symbol or missing dependency"
                            :log log-str)))
      ((search "PACKAGE" log-str :test 'char-equal)
       (setf extracted-type :package-error
             diagnosis (list :type :package-error
                            :detail "Package resolution error"
                            :log log-str)))
      (t
       (setf extracted-type :unknown
             diagnosis (list :type :unknown
                            :detail (format nil "Unrecognized error: ~a"
                                            (subseq log-str 0 (min 200 (length log-str))))
                            :log log-str))))
    (log-message "SELF-IMPROVE: Diagnosed ~a as ~a" skill-name extracted-type)
    (let ((repair-result
            (when (eql extracted-type :syntax-error)
              (self-improve-repair-syntax skill-name))))
      (if (and repair-result (getf repair-result :repaired))
          (progn
            (log-message "SELF-IMPROVE: Successfully repaired ~a" skill-name)
            repair-result)
          (list :status :error
                :reason (format nil "Diagnosis for ~a: ~a" skill-name
                                (getf diagnosis :detail))
                :diagnosis diagnosis
                :repaired nil)))))

(defskill :passepartout-symbolic-self-improve
  :priority 100
  :trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
  :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))