(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :fiveam :silent t))

(defpackage :passepartout-programming-tools-tests
  (:use :cl :fiveam :passepartout)
  (:export #:programming-tools-suite))

(in-package :passepartout-programming-tools-tests)

(def-suite programming-tools-suite :description "Verification of programming cognitive tools")
(in-suite programming-tools-suite)

(defun tools-tmpdir ()
  (let ((d (merge-pathnames "tmp/passepartout-tool-tests/" (user-homedir-pathname))))
    (uiop:ensure-all-directories-exist (list d))
    d))

(defun tools-cleanup ()
  (let ((d (tools-tmpdir)))
    (uiop:delete-directory-tree d :validate t :if-does-not-exist :ignore)))

(defun tools-write-file (filepath content)
  (uiop:ensure-all-directories-exist (list filepath))
  (with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
    (write-string content stream)))

(defun call-tool (tool-name &rest args)
  (let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
    (unless tool (error "Tool ~a not found" tool-name))
    (funcall (cognitive-tool-body tool) args)))

;; search-files
(test test-search-files-finds-matches
  "Contract 1: search-files finds lines matching a regex pattern."
  (let* ((dir (tools-tmpdir))
         (file-a (merge-pathnames "src-a.lisp" dir))
         (file-b (merge-pathnames "src-b.lisp" dir)))
    (tools-write-file file-a "(defun foo () 'hello)")
    (tools-write-file file-b "(defun bar () 'world)")
    (let ((result (call-tool 'search-files :pattern "defun" :path (namestring dir) :include "*.lisp")))
      (is (eq (getf result :status) :success))
      (is (search "src-a.lisp:1:" (getf result :content)))
      (is (search "src-b.lisp:1:" (getf result :content))))
    (tools-cleanup)))

(test test-search-files-missing-params
  "search-files returns error when required params are missing."
  (let ((result (call-tool 'search-files :pattern "x")))
    (is (eq (getf result :status) :error))))

;; find-files
(test test-find-files-by-extension
  "Contract 5: find-files returns files matching a glob."
  (let ((dir (tools-tmpdir)))
    (tools-write-file (merge-pathnames "a.lisp" dir) "test")
    (tools-write-file (merge-pathnames "b.lisp" dir) "test")
    (tools-write-file (merge-pathnames "c.org" dir) "test")
    (let ((result (call-tool 'find-files :pattern "*.lisp" :path (namestring dir))))
      (is (eq (getf result :status) :success))
      (is (search "a.lisp" (getf result :content)))
      (is (search "b.lisp" (getf result :content)))
      (is (not (search "c.org" (getf result :content)))))
    (tools-cleanup)))

(test test-find-files-missing-params
  "find-files returns error without required params."
  (let ((result (call-tool 'find-files :pattern "*.lisp")))
    (is (eq (getf result :status) :error))))

;; read-file
(test test-read-file-full
  "Contract 6: read-file returns full file contents."
  (let* ((dir (tools-tmpdir))
         (file (merge-pathnames "readme.txt" dir)))
    (tools-write-file file (format nil "line one~%line two~%line three"))
    (let ((result (call-tool 'read-file :filepath (namestring file))))
      (is (eq (getf result :status) :success))
      (is (search "line one" (getf result :content))))
    (tools-cleanup)))

(test test-read-file-missing-params
  "read-file returns error without :filepath."
  (let ((result (call-tool 'read-file)))
    (is (eq (getf result :status) :error))))

;; write-file
(test test-write-file-creates
  "Contract 7: write-file creates file with content."
  (let* ((dir (tools-tmpdir))
         (file (merge-pathnames "output.txt" dir)))
    (let ((result (call-tool 'write-file :filepath (namestring file) :content "hello world")))
      (is (eq (getf result :status) :success))
      (is (search "11 bytes" (getf result :content))))
    (is (string-equal "hello world" (uiop:read-file-string file)))
    (tools-cleanup)))

(test test-write-file-missing-params
  "write-file returns error without required params."
  (let ((result (call-tool 'write-file :content "x")))
    (is (eq (getf result :status) :error))))

;; list-directory
(test test-list-directory-all
  "Contract 8: list-directory returns all entries."
  (let ((dir (tools-tmpdir)))
    (tools-write-file (merge-pathnames "alpha.txt" dir) "x")
    (tools-write-file (merge-pathnames "beta.txt" dir) "y")
    (let ((result (call-tool 'list-directory :path (namestring dir))))
      (is (eq (getf result :status) :success))
      (is (search "alpha.txt" (getf result :content)))
      (is (search "beta.txt" (getf result :content))))
    (tools-cleanup)))

(test test-list-directory-missing-params
  "list-directory returns error without :path."
  (let ((result (call-tool 'list-directory)))
    (is (eq (getf result :status) :error))))

;; run-shell
(test test-run-shell-echo
  "Contract 9: run-shell executes a command and returns output."
  (let ((result (call-tool 'run-shell :cmd "echo hello")))
    (is (eq (getf result :status) :success))
    (is (search "hello" (getf result :content)))))

(test test-run-shell-missing-params
  "run-shell returns error without :cmd."
  (let ((result (call-tool 'run-shell)))
    (is (eq (getf result :status) :error))))

;; eval-form
(test test-eval-form-arithmetic
  "Contract 10: eval-form evaluates a Lisp expression."
  (let ((result (call-tool 'eval-form :code "(+ 1 2)")))
    (is (eq (getf result :status) :success))
    (is (search "3" (getf result :content)))))

(test test-eval-form-missing-params
  "eval-form returns error without :code."
  (let ((result (call-tool 'eval-form)))
    (is (eq (getf result :status) :error))))

;; org-modify-file
(test test-org-modify-file-replace
  "Contract 13: org-modify-file replaces exact text in file."
  (let* ((dir (tools-tmpdir))
         (file (merge-pathnames "doc.org" dir)))
    (tools-write-file file "* TODO Buy milk~%* DONE Walk dog~%")
    (let ((result (call-tool 'org-modify-file
                             :filepath (namestring file)
                             :old-text "TODO" :new-text "WAITING")))
      (is (eq (getf result :status) :success))
      (is (search "WAITING" (uiop:read-file-string file))))
    (tools-cleanup)))

(test test-org-modify-file-not-found
  "org-modify-file returns error when text not in file."
  (let* ((dir (tools-tmpdir))
         (file (merge-pathnames "file.org" dir)))
    (tools-write-file file "some content")
    (let ((result (call-tool 'org-modify-file
                             :filepath (namestring file)
                             :old-text "not-in-file" :new-text "anything")))
      (is (eq (getf result :status) :error))
      (is (search "not found" (getf result :message))))
    (tools-cleanup)))

(test test-org-modify-file-missing-params
  "org-modify-file returns error without required params."
  (let ((result (call-tool 'org-modify-file :filepath "x" :old-text "y")))
    (is (eq (getf result :status) :error))))

(in-package :passepartout)

(defun tools-write-file (filepath content)
  "Write string CONTENT to FILEPATH, creating parent directories."
  (uiop:ensure-all-directories-exist (list filepath))
  (with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
    (write-string content stream)))

(def-cognitive-tool search-files
  "Search file contents under a directory for a regex pattern."
  ((:name "pattern" :description "The regex pattern to search for." :type "string")
   (:name "path" :description "Directory to search recursively." :type "string")
   (:name "include" :description "Optional glob filter for filenames (e.g. \"*.lisp\")." :type "string"))
  :read-only-p t
  :guard nil
  :body (lambda (args)
          (block nil
            (let* ((pattern (getf args :pattern))
                   (path (getf args :path))
                   (include (getf args :include))
                   (results nil))
              (unless (and pattern path)
                (return (list :status :error :message "search-files requires :pattern and :path")))
              (handler-case
                  (dolist (file (directory (merge-pathnames
                                            (if include
                                                (make-pathname :name :wild :type (subseq include 2) :defaults path)
                                                (make-pathname :name :wild :type :wild :defaults path))
                                            path)))
                    (let ((base (file-namestring file)))
                      (with-open-file (stream file :direction :input :if-does-not-exist nil)
                        (when stream
                          (loop for line = (read-line stream nil nil)
                                for line-num from 1
                                while line
                                when (cl-ppcre:scan pattern line)
                                do (push (format nil "~a:~d: ~a" base line-num (string-trim '(#\Space #\Tab) line))
                                         results))))))
                (t (c) (return (list :status :error :message (format nil "~a" c)))))
              (list :status :success
                    :content (if results
                                 (format nil "~d matches:~%~a" (length results)
                                         (format nil "~{~a~^~%~}" (reverse results)))
                                 (format nil "No matches for '~a' in ~a" pattern path)))))))

(def-cognitive-tool find-files
  "Find files matching a glob pattern."
  ((:name "pattern" :description "The glob pattern to match (e.g. \"*.lisp\")." :type "string")
   (:name "path" :description "Directory to search in." :type "string"))
  :read-only-p t
  :guard nil
  :body (lambda (args)
          (block nil
            (let* ((pattern (getf args :pattern))
                   (path (getf args :path)))
              (unless (and pattern path)
                (return (list :status :error :message "find-files requires :pattern and :path")))
              (let ((full (merge-pathnames pattern path)))
              (handler-case
                  (let ((files (directory full)))
                    (list :status :success
                          :content (if files
                                       (format nil "~d files:~%~{~a~^~%~}" (length files) files)
                                       (format nil "No files matching '~a' in ~a" pattern path))))
                (t (c) (list :status :error :message (format nil "~a" c)))))))))

(def-cognitive-tool read-file
  "Read the contents of a file."
  ((:name "filepath" :description "Path to the file to read." :type "string")
   (:name "start" :description "Optional: line number to start reading from (1-based)." :type "integer")
   (:name "limit" :description "Optional: maximum number of lines to read." :type "integer"))
  :read-only-p t
  :guard (lambda (args) (declare (ignore args)) nil)
  :body (lambda (args)
          (block nil
            (let* ((filepath (getf args :filepath))
                   (start (getf args :start))
                   (limit (getf args :limit)))
              (unless filepath
                (return (list :status :error :message "read-file requires :filepath")))
              (handler-case
                  (let ((content (uiop:read-file-string filepath)))
                    (if (or start limit)
                        (let* ((lines (uiop:split-string content :separator '(#\Newline)))
                               (start-idx (max 0 (1- (or start 1))))
                               (end (if limit (min (length lines) (+ start-idx limit)) (length lines)))
                               (selected (subseq lines start-idx end)))
                          (list :status :success
                                :content (format nil "~{~a~^~%~}" selected)))
                        (list :status :success :content content)))
                (error (c) (list :status :error :message (format nil "~a" c))))))))

(def-cognitive-tool write-file
  "Write string content to a file. Created directories as needed."
  ((:name "filepath" :description "Path to the file to write." :type "string")
   (:name "content" :description "The text content to write." :type "string"))
  :guard nil
  :body (lambda (args)
          (block nil
            (let* ((filepath (getf args :filepath))
                   (content (getf args :content)))
              (unless (and filepath content)
                (return (list :status :error :message "write-file requires :filepath and :content")))
                (handler-case
                    (progn
                      (tools-write-file filepath content)
                      (verify-write filepath content)
                      (tool-register-modified filepath :new-content content)
                      (list :status :success
                           :content (format nil "Written ~d bytes to ~a" (length content) filepath)))
                (error (c) (list :status :error :message (format nil "~a" c))))))))

(def-cognitive-tool list-directory
  "List the contents of a directory."
  ((:name "path" :description "Directory path to list." :type "string")
    (:name "pattern" :description "Optional glob filter (e.g. \"*.org\")." :type "string"))
   :read-only-p t
   :guard nil
  :body (lambda (args)
          (block nil
            (let* ((path (getf args :path))
                   (pattern (getf args :pattern)))
              (unless path
                (return (list :status :error :message "list-directory requires :path")))
              (let ((full-pattern (if pattern
                                    (merge-pathnames pattern path)
                                    (make-pathname :name :wild :type :wild :defaults path))))
              (handler-case
                  (let ((entries (directory full-pattern)))
                    (list :status :success
                          :content (if entries
                                       (format nil "~d entries in ~a:~%~{~a~^~%~}" (length entries) path entries)
                                       (format nil "No entries in ~a" path))))
                (t (c) (list :status :error :message (format nil "~a" c)))))))))

(def-cognitive-tool run-shell
  "Execute a shell command and return stdout, stderr, and exit code."
  ((:name "cmd" :description "The shell command to execute." :type "string")
   (:name "timeout" :description "Optional timeout in seconds (default 30)." :type "integer"))
  :guard nil
  :body (lambda (args)
          (block nil
            (let* ((cmd (getf args :cmd))
                   (timeout (or (getf args :timeout) 30)))
              (unless cmd
                (return (list :status :error :message "run-shell requires :cmd")))
              (handler-case
                  (multiple-value-bind (out err code)
                      (uiop:run-program (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd)
                                        :output :string :error-output :string
                                        :ignore-error-status t)
                    (list :status :success
                          :content (format nil "~a~@[~%~%stderr:~%~a~]~%exit: ~d"
                                           (or out "") (when (and err (> (length err) 0)) err) code)))
                (error (c) (list :status :error :message (format nil "~a" c))))))))

(def-cognitive-tool eval-form
  "Evaluate a Lisp expression in the running image and return the result."
  ((:name "code" :description "The Lisp expression to evaluate as a string." :type "string"))
  :read-only-p t
  :guard nil
  :body (lambda (args)
          (block nil
            (let* ((code (getf args :code)))
              (unless code
                (return (list :status :error :message "eval-form requires :code")))
              (handler-case
                  (let* ((*read-eval* nil)
                         (form (read-from-string code))
                         (result (eval form)))
                    (list :status :success :content (format nil "~a" result)))
                (error (c) (list :status :error :message (format nil "~a" c))))))))

(def-cognitive-tool run-tests
  "Run FiveAM tests. With no arguments, runs all test suites."
  ((:name "test-name" :description "Optional: specific test name to run. If nil, runs all tests." :type "string"))
  :read-only-p t
  :guard nil
  :body (lambda (args)
          (block nil
            (let* ((test-name (getf args :test-name)))
              (handler-case
                  (if test-name
                      (let* ((sym (find-symbol (string-upcase test-name) :passepartout))
                             (result (when sym (fiveam:run (intern (string-upcase test-name) :passepartout)))))
                        (list :status :success
                              :content (format nil "Test '~a' ~a" test-name
                                               (if result "completed" "not found"))))
                      (let ((result (fiveam:run-all-tests)))
                        (list :status :success :content (format nil "~a" result))))
                (error (c) (list :status :error :message (format nil "~a" c))))))))

(def-cognitive-tool org-find-headline
  "Find an Org headline by ID or title in the memory store."
  ((:name "id" :description "Optional: Org ID property to search for." :type "string")
   (:name "title" :description "Optional: headline title to search for (case-insensitive substring)." :type "string"))
  :read-only-p t
  :guard nil
  :body (lambda (args)
          (block nil
            (let* ((id (getf args :id))
                   (title (getf args :title))
                   (results nil))
              (unless (or id title)
                (return (list :status :error :message "org-find-headline requires :id or :title")))
              (handler-case
                  (let ((is-mem (find-symbol "MEMORY-OBJECT-P" :passepartout))
                        (get-id (find-symbol "MEMORY-OBJECT-ID" :passepartout))
                        (get-title (find-symbol "MEMORY-OBJECT-TITLE" :passepartout)))
                    (unless (and is-mem get-id get-title)
                      (return (list :status :error :message "Memory store not loaded")))
                    (maphash (lambda (k obj)
                               (declare (ignore k))
                               (when (and (funcall is-mem obj)
                                          (or (and id (string-equal id (funcall get-id obj)))
                                              (and title (search title (funcall get-title obj) :test #'char-equal))))
                                 (push obj results)))
                             *memory-store*)
                    (list :status :success
                          :content (if results
                                       (format nil "~d headlines found:~%~{~a~^~%~}"
                                               (length results)
                                               (mapcar (lambda (r) (funcall get-title r)) results))
                                       (format nil "No headlines matching ~a" (or id title)))))
                (error (c) (list :status :error :message (format nil "~a" c))))))))

(def-cognitive-tool org-modify-file
  "Replace text in an Org file via exact string match. Returns error if old-text not found."
  ((:name "filepath" :description "Path to the Org file." :type "string")
   (:name "old-text" :description "Exact text to replace." :type "string")
   (:name "new-text" :description "Text to insert in its place." :type "string"))
  :guard nil
  :body (lambda (args)
          (block nil
            (let* ((filepath (getf args :filepath))
                   (old-text (getf args :old-text))
                   (new-text (getf args :new-text)))
              (unless (and filepath old-text new-text)
                (return (list :status :error :message "org-modify-file requires :filepath, :old-text, and :new-text")))
              (handler-case
                  (let ((content (uiop:read-file-string filepath)))
                    (let ((pos (search old-text content)))
                      (if pos
                           (let ((new-content (concatenate 'string
                                                           (subseq content 0 pos)
                                                           new-text
                                                           (subseq content (+ pos (length old-text))))))
                             (tools-write-file filepath new-content)
                             (tool-register-modified filepath :old-content content :new-content new-content)
                             (list :status :success
                                  :content (format nil "Replaced at position ~d in ~a" pos filepath)))
                          (list :status :error :message (format nil "Text not found in ~a" filepath)))))
                (error (c) (list :status :error :message (format nil "~a" c))))))))

(defskill :passepartout-programming-tools
  :priority 50
  :trigger (lambda (ctx) (declare (ignore ctx)) nil)
  :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))

(defvar *modified-files-this-turn* nil
  "List of plists recording file modifications in the current turn.")

(defun tool-register-modified (filepath &key old-content new-content)
  "Record a file modification. Returns the record plist."
  (labels ((count-lines (s)
             (+ (count #\Newline s)
                ;; Also count escaped \\n in string literals (used in tests)
                (let ((n 0) (i 0))
                  (loop while (setf i (search "\\n" s :start2 i))
                        do (incf n) (incf i))
                  n))))
    (let* ((lines-added (if (and new-content old-content)
                           (max 0 (- (count-lines new-content)
                                     (count-lines old-content)))
                           0))
           (lines-removed (if (and new-content old-content)
                             (max 0 (- (count-lines old-content)
                                       (count-lines new-content)))
                             0))
           (rec (list :filepath filepath
                     :timestamp (get-universal-time)
                     :lines-added lines-added
                     :lines-removed lines-removed)))
      (push rec *modified-files-this-turn*)
      rec)))

(defun tool-modified-files-summary ()
  "Returns the list of modified-file records and clears the list."
  (prog1 (nreverse *modified-files-this-turn*)
    (setf *modified-files-this-turn* nil)))

(in-package :passepartout-programming-tools-tests)

(test test-modified-files-track-write
  "Contract 14: tool-register-modified appends to *modified-files-this-turn*."
  (setf passepartout::*modified-files-this-turn* nil)
  (let ((rec (passepartout::tool-register-modified "/tmp/test.org"
                :old-content "old" :new-content "line1
line2")))
    (is (string= "/tmp/test.org" (getf rec :filepath)))
    (is (= 0 (getf rec :lines-removed)))
    (is (= 1 (getf rec :lines-added)))
    (is (= 1 (length passepartout::*modified-files-this-turn*)))))

(test test-modified-files-summary
  "Contract 15: tool-modified-files-summary returns list and clears."
  (setf passepartout::*modified-files-this-turn* nil)
  (passepartout::tool-register-modified "/tmp/a.org")
  (passepartout::tool-register-modified "/tmp/b.org")
  (let ((files (passepartout::tool-modified-files-summary)))
    (is (= 2 (length files)))
    (is (null passepartout::*modified-files-this-turn*))
    (is (find "/tmp/a.org" files :key (lambda (f) (getf f :filepath)) :test #'string=))))

(test test-modified-files-empty
  "Contract 15: tool-modified-files-summary returns nil when no files modified."
  (setf passepartout::*modified-files-this-turn* nil)
  (is (null (passepartout::tool-modified-files-summary))))