amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity
Files
a0694d6489de6d7192c834b81d9b72930fd82248
passepartout/org/programming-tools.org
Amr Gharbeia b9a4318ef8 reorg: tangle to XDG, remove stale lisp files, fix tui input 
- Changed all 50 org file :tangle targets from ../lisp/ to
  ~/.local/share/passepartout/lisp/ (XDG data dir)
- Removed 49 generated .lisp files from project lisp/ directory
- Removed tests/system-integration-tests.lisp (generated)
- Removed lisp/*.fasl (compiled, stale)
- Updated core-manifest.org to tangle .asd to XDG root
- Remapped quicklisp symlink: local-projects/passepartout → XDG

TUI fixes in channel-tui-main.org:
- Removed with-raw-terminal (stty raw breaks fd 0 reads in this SBCL)
- Use cat subprocess + pipe for keyboard input (via :input :interactive)
- Blocking read-char on pipe with with-timeout 0.1s for daemon processing
- Key events queued via drain-queue alongside daemon messages
- Full dialog key routing (Escape, Up/Down, Enter, filters, Backspace)
- SIGWINCH resize handling
- Post-handshake backend-size re-query
- Daemon version in status bar (was v0.5.0 hardcoded)
- Handshake version stored in state, no add-msg
- :daemon-version and :size-queried in state plist
- view-status uses draw-rect for background
- Test section gated with #+passepartout-tests
2026-05-14 12:34:06 -04:00

844 lines
35 KiB
Org Mode
Raw Blame History

#+TITLE: SKILL: Programming Tools (programming-tools.org)
#+AUTHOR: Agent
#+FILETAGS: :programming:tools:cognitive:
#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/programming-tools.lisp
* Cognitive Tools for Codebase Operations
This skill registers ten cognitive tools that let the LLM search codebases, read and write files, evaluate Lisp expressions, run tests, and manipulate Org files. Without these tools, the agent can chat and run shell commands but cannot perform the core operations of a programming assistant.
Each tool is registered via ~def-cognitive-tool~ and appears in the LLM's tool belt prompt via ~cognitive-tool-prompt~. Tools receive arguments as a plist and return a plist with ~:status~ (~:success or :error~) and either ~:content~ (success) or ~:message~ (error). The tool executor (~action-tool-execute~) normalizes nested argument lists, dispatches by name, and feeds results back into the perception pipeline.
** Contract
1. Every tool returns a plist with at least ~:status~. On success: ~(:status :success :content "...")~. On error: ~(:status :error :message "...")~.
2. Every tool guards against missing required parameters and returns a clear error message.
3. Every tool handles runtime exceptions (~handler-case~) — a tool must never crash the daemon.
4. ~search-files~: given ~:pattern~, ~:path~, optional ~:include~ (glob), returns matched lines with file:line prefixes.
5. ~find-files~: given ~:pattern~ (glob), ~:path~, returns list of matching file paths.
6. ~read-file~: given ~:filepath~, optional ~:start~, ~:limit~ (lines), returns file contents.
7. ~write-file~: given ~:filepath~, ~:content~, creates directories, writes file, returns byte count.
8. ~list-directory~: given ~:path~, optional ~:pattern~, returns sorted directory entries.
9. ~run-shell~: given ~:cmd~, optional ~:timeout~, returns stdout, stderr, and exit code.
10. ~eval-form~: given ~:code~ (Lisp expression string), returns evaluated result. Disables ~*read-eval*~.
11. ~run-tests~: given optional ~:test-name~, runs specific test or all suites via ~fiveam:run-all-tests~.
12. ~org-find-headline~: given ~:id~ or ~:title~, searches ~*memory-store*~ for matching memory objects.
13. ~org-modify-file~: given ~:filepath~, ~:old-text~, ~:new-text~, performs exact-string replacement. Returns error if text not found.
14. (tool-register-modified filepath &key old-content new-content):
appends a modification record to ~*modified-files-this-turn*~.
Returns the record plist ~(:filepath <s> :timestamp <unix>
:lines-added <n> :lines-removed <n>)~.
15. (tool-modified-files-summary): returns the list of modified-file
plists accumulated this turn and clears ~*modified-files-this-turn*~.
Returns nil when no files were modified.
** v0.8.0 — Modified Files Tracking
The sidebar's Files panel needs to know which files the agent modified in
the most recent tool execution. ~*modified-files-this-turn*~ is a list of
plists tracking each write operation: ~(:filepath <string> :timestamp <unix>
:lines-added <int> :lines-removed <int>)~.
~tool-register-modified~ is called by ~write-file~ and ~org-modify-file~
after successful writes. It computes line counts by comparing the old and
new content (when available) or records the operation with nil counts.
~tool-modified-files-summary~ returns the accumulated list and resets
it for the next turn (reset happens at the start of each ~think()~ cycle
in ~core-reason.lisp~).
The tracking is per-turn, not cumulative — the sidebar shows what changed
in the /last/ tool execution, matching the tool-execution visualization
pattern from v0.7.1. Cumulative file tracking belongs in the version
control system.
* Implementation
** Package Context
#+begin_src lisp
(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)))
#+end_src
** Tool: search-files
Searches file contents recursively under a directory using regex pattern matching.
#+begin_src lisp
(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)))))))
#+end_src
** Tool: find-files
Glob file matching using SBCL's ~directory~.
#+begin_src lisp
(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)))))))))
#+end_src
** Tool: read-file
Reads a file into a string. Supports optional ~:start~ and ~:limit~ for partial reads.
#+begin_src lisp
(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))))))))
#+end_src
** Tool: write-file
Writes string content to a file, creating parent directories as needed.
#+begin_src lisp
(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))))))))
#+end_src
** Tool: list-directory
Lists the contents of a directory, optionally filtered by a glob pattern.
#+begin_src lisp
(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)))))))))
#+end_src
** Tool: run-shell
Executes a shell command and returns stdout, stderr, and exit code.
#+begin_src lisp
(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))))))))
#+end_src
** Tool: eval-form
Evaluates a Lisp expression in the running image. Binds ~*read-eval*~ to nil for safety.
#+begin_src lisp
(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))))))))
#+end_src
** Tool: run-tests
Runs FiveAM test suites. Without arguments, runs all tests via ~fiveam:run-all-tests~.
#+begin_src lisp
(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))))))))
#+end_src
** Tool: org-find-headline
Finds Org headlines in the memory store by ID property or title substring match.
#+begin_src lisp
(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))))))))
#+end_src
** Tool: org-modify-file
Surgical text replacement in an Org file — matches exact text and replaces it.
#+begin_src lisp
(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))))))))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :passepartout-programming-tools
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
#+end_src
** Package Definition and Export List
The package definition. All public symbols are exported here.
#+begin_src lisp :tangle no
(defpackage :passepartout
(:use :cl)
(:export
#:frame-message
#:read-framed-message
#:PROTO-GET
#:proto-get
#:*VAULT-MEMORY*
#:make-hello-message
#:validate-communication-protocol-schema
#:start-daemon
#:log-message
#:main
#:diagnostics-run-all
#:diagnostics-main
#:diagnostics-dependencies-check
#:diagnostics-env-check
#:register-provider
#:provider-openai-request
#:provider-config
#:run-setup-wizard
#:ingest-ast
#:memory-object-get
#:*memory-store*
#:memory-object
#:make-memory-object
#:memory-object-id
#:memory-object-type
#:memory-object-attributes
#:memory-object-parent-id
#:memory-object-children
#:memory-object-version
#:memory-object-last-sync
#:memory-object-vector
#:memory-object-content
#:memory-object-hash
#:memory-object-scope
#:snapshot-memory
#:rollback-memory
#:context-get-system-logs
#:context-assemble-global-awareness
#:context-awareness-assemble
#:context-query
#:push-context
#:pop-context
#:current-context
#:current-scope
#:context-stack-depth
#:context-save
#:context-load
#:focus-project
#:focus-session
#:focus-memex
#:unfocus
#:process-signal
#:loop-process
#:perceive-gate
#:loop-gate-perceive
#:act-gate
#:loop-gate-act
#:reason-gate
#:loop-gate-reason
#:cognitive-verify
#:backend-cascade-call
#:json-alist-to-plist
#:inject-stimulus
#:stimulus-inject
#:hitl-create
#:hitl-approve
#:hitl-deny
#:hitl-handle-message
#:dispatcher-check-secret-path
#:dispatcher-check-shell-safety
#:dispatcher-check-privacy-tags
#:dispatcher-check-network-exfil
#:dispatcher-gate
#:wildcard-match
#:actuator-initialize
#:action-dispatch
#:register-actuator
#:load-skill-from-org
#:skill-initialize-all
#:lisp-syntax-validate
#:defskill
#:*skill-registry*
#:*scope-resolver*
#:*embedding-backend*
#:*embedding-queue*
#:*embedding-provider*
#:embed-queue-object
#:embed-object
#:embed-all-pending
#:embedding-backend-hashing
#:embedding-backend-native
#:embedding-native-load-model
#:embedding-native-unload
#:embedding-native-ensure-loaded
#:embedding-native-get-dim
#:embeddings-compute
#:mark-vector-stale
#:skill
#:skill-name
#:skill-priority
#:skill-dependencies
#:skill-trigger-fn
#:skill-probabilistic-prompt
#:skill-deterministic-fn
#:def-cognitive-tool
#:*cognitive-tool-registry*
#:org-read-file
#:org-write-file
#:org-headline-add
#:org-headline-find-by-id
#:literate-tangle-sync-check
#:archivist-create-note
#:gateway-start
#:org-property-set
#:org-todo-set
#:org-id-generate
#:org-id-format
#:org-modify
#:lisp-validate
#:lisp-structural-check
#:lisp-syntactic-check
#:lisp-semantic-check
#:lisp-eval
#:lisp-format
#:lisp-list-definitions
#:lisp-extract
#:lisp-inject
#:lisp-slurp
#:get-oc-config-dir
#:get-tool-permission
#:set-tool-permission
#:check-tool-permission-gate
#:permission-get
#:permission-set
#:cognitive-tool
#:cognitive-tool-name
#:cognitive-tool-description
#:cognitive-tool-parameters
#:cognitive-tool-guard
#:cognitive-tool-body
#:register-probabilistic-backend
#:*probabilistic-backends*
#:*provider-cascade*
#:vault-get
#:vault-set
#:vault-get-secret
#:vault-set-secret
#:memory-objects-by-attribute
#:channel-cli-input
#:repl-eval
#:repl-inspect
#:repl-list-vars
#:policy-compliance-check
#:validator-protocol-check
#:archivist-extract-headlines
#:archivist-headline-to-filename
#:literate-extract-lisp-blocks
#:literate-block-balance-check
#:gateway-registry-initialize
#:messaging-link
#:messaging-unlink
#:gateway-configured-p))
#+end_src
** Package Implementation
The package implementation section defines the low-level utilities and global state that are shared across all harness components and skills.
*** Robust plist access (plist-get)
Retrieves a value from a plist, checking both upper and lowercase keyword variants. This is needed because different components use different keyword conventions.
#+begin_src lisp :tangle no
(in-package :passepartout)
(defun plist-get (plist key)
"Robust plist accessor — checks both :KEY and :key variants."
(let* ((s (string key))
(up (intern (string-upcase s) :keyword))
(dn (intern (string-downcase s) :keyword)))
(or (getf plist up) (getf plist dn))))
#+end_src
*** Logging state
The harness maintains a bounded ring buffer of log messages for inclusion in LLM context. Access is thread-safe via a lock.
#+begin_src lisp :tangle no
(defvar *log-buffer* nil)
(defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock"))
(defvar *log-limit* 100)
#+end_src
*** Skill registry
The global registry of all loaded skills. This is the authoritative list that the deterministic engine iterates.
#+begin_src lisp :tangle no
(defvar *skill-registry* (make-hash-table :test 'equal)
"Global registry of all loaded skills.")
#+end_src
*** Skill telemetry
Tracks execution metrics per skill (count, duration, failures) for diagnostics and performance analysis.
#+begin_src lisp :tangle no
(defvar *telemetry-table* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
(defun telemetry-track (skill-name duration status)
"Updates performance metrics for a skill. STATUS is :success or :rejected."
(when skill-name
(bordeaux-threads:with-lock-held (*telemetry-lock*)
(let ((entry (or (gethash skill-name *telemetry-table*) (list :executions 0 :total-time 0 :failures 0))))
(incf (getf entry :executions))
(incf (getf entry :total-time) duration)
(when (eq status :rejected) (incf (getf entry :failures)))
(setf (gethash skill-name *telemetry-table*) entry)))))
#+end_src
*** Cognitive tool registry
Tools that the LLM can invoke are registered here. Each tool has a name, description, parameters, optional guard, and implementation body. The ~def-cognitive-tool~ macro handles registration. ~cognitive-tool-prompt~ serialises the registry into the LLM's system prompt.
#+begin_src lisp :tangle no
(defvar *cognitive-tool-registry* (make-hash-table :test 'equal))
#+end_src
* Test Suite
#+begin_src lisp
(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))))
#+end_src* v0.8.0 — Modified Files Tracking
#+begin_src lisp
(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)))
#+end_src
* v0.8.0 Tests — Modified Files Tracking
#+begin_src lisp
(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))))
#+end_src
Reference in New Issue View Git Blame Copy Permalink