skill-loader export fix + TUI config panel + provider test + slot descriptions
- Fix skill loader export: unintern before import (handle existing symbols) - Add ignore-errors around export (handle package conflicts) - Add test-provider-connection (live API key testing for TUI config) - Add *slot-descriptions* with per-slot explanations for TUI config screen - Rewrite gateway-tui with expanding minibuffer config panel (F2 toggle) - Fix skill loader exclusion list: add system-model-router - All org files updated with proper prose
This commit is contained in:
1
docs/.#ROADMAP.org
Symbolic link
1
docs/.#ROADMAP.org
Symbolic link
@@ -0,0 +1 @@
|
||||
user@amr.1092521:1777807168
|
||||
@@ -218,10 +218,9 @@
|
||||
(setf (gethash (symbol-name sym) seen) t)
|
||||
(incf exported)
|
||||
(let ((existing (find-symbol (symbol-name sym) target-pkg)))
|
||||
(when (and existing (not (eq existing sym)))
|
||||
(unintern existing target-pkg)))
|
||||
(import sym target-pkg)
|
||||
(export sym target-pkg)))
|
||||
(when existing (unintern existing target-pkg)))
|
||||
(import sym target-pkg)
|
||||
(ignore-errors (export sym target-pkg))))
|
||||
(log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
|
||||
exported (package-name (find-package pkg-name))))
|
||||
|
||||
@@ -259,10 +258,9 @@
|
||||
(setf (gethash (symbol-name sym) seen) t)
|
||||
(incf exported)
|
||||
(let ((existing (find-symbol (symbol-name sym) target-pkg)))
|
||||
(when (and existing (not (eq existing sym)))
|
||||
(unintern existing target-pkg)))
|
||||
(when existing (unintern existing target-pkg)))
|
||||
(import sym target-pkg)
|
||||
(export sym target-pkg)))
|
||||
(ignore-errors (export sym target-pkg))))
|
||||
(log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
|
||||
exported (package-name (find-package pkg-name))))
|
||||
(setf (skill-entry-status entry) :ready))
|
||||
|
||||
@@ -1,263 +1,292 @@
|
||||
(in-package :cl-user)
|
||||
(defpackage :passepartout.gateway-tui
|
||||
(:use :cl :croatoan :usocket :bordeaux-threads)
|
||||
(:export :main))
|
||||
(in-package :passepartout.gateway-tui)
|
||||
(in-package :passepartout)
|
||||
|
||||
(defvar *daemon-host* "localhost")
|
||||
(defvar *stream* nil "TCP stream to daemon")
|
||||
(defvar *input-buffer* nil "Current input line as reversed char list")
|
||||
(defvar *input-history* nil "Sent messages (newest first)")
|
||||
(defvar *input-history-pos* 0 "Position in input history for nav")
|
||||
(defvar *chat-history* nil "List of (direction . text) entries")
|
||||
(defvar *chat-scroll-pos* 0 "How many lines from bottom we scrolled up")
|
||||
(defvar *is-running* t "Main loop flag")
|
||||
(defvar *tui-mode* :chat "Current mode: :chat or :config")
|
||||
(defvar *config-selection* 0 "Selected menu item in config panel")
|
||||
(defvar *config-panel-height* 10 "Height of config panel when open")
|
||||
|
||||
(defvar *daemon-port* 9105)
|
||||
(defun send-message (stream msg)
|
||||
"Send a framed s-expression over TCP."
|
||||
(let* ((sexp (format nil "(~a)" msg))
|
||||
(len (length sexp))
|
||||
(header (format nil "~6,'0x" len)))
|
||||
(write-sequence (babel:string-to-octets (concatenate 'string header sexp)) stream)
|
||||
(force-output stream)
|
||||
(log-message "SENT: ~a" sexp)))
|
||||
|
||||
(defvar *socket* nil)
|
||||
(defun read-message (stream)
|
||||
"Read a framed s-expression from TCP."
|
||||
(handler-case
|
||||
(let* ((header (make-array 6 :element-type '(unsigned-byte 8)))
|
||||
(read (read-sequence header stream)))
|
||||
(when (< read 6) (return-from read-message nil))
|
||||
(let* ((hex (babel:octets-to-string header))
|
||||
(len (parse-integer hex :radix 16 :junk-allowed t))
|
||||
(buf (make-array len :element-type '(unsigned-byte 8))))
|
||||
(read-sequence buf stream)
|
||||
(read-from-string (babel:octets-to-string buf))))
|
||||
(error () nil)))
|
||||
|
||||
(defvar *stream* nil)
|
||||
|
||||
(defvar *chat-history* nil)
|
||||
|
||||
(defvar *chat-scroll-pos* 0)
|
||||
|
||||
(defvar *input-buffer* nil)
|
||||
|
||||
(defvar *input-history* nil)
|
||||
(defvar *input-history-pos* nil)
|
||||
|
||||
(defvar *is-running* t)
|
||||
|
||||
(defvar *queue-lock* (bt:make-lock "incoming-queue-lock"))
|
||||
|
||||
(defvar *incoming* nil)
|
||||
|
||||
(defun log-debug (msg &rest args)
|
||||
(ignore-errors
|
||||
(with-open-file (s "/tmp/passepartout-tui-debug.log" :direction :output :if-exists :append :if-does-not-exist :create)
|
||||
(format s "[~a] " (get-universal-time))
|
||||
(apply #'format s msg args)
|
||||
(terpri s)
|
||||
(finish-output s))))
|
||||
(defvar *message-queue* nil
|
||||
"List of incoming daemon messages from reader thread.")
|
||||
(defvar *message-queue-lock* (bt:make-lock "msg-queue-lock")
|
||||
"Lock for thread-safe queue access.")
|
||||
|
||||
(defun message-queue-push (msg)
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
(setf *incoming* (append *incoming* (list msg)))))
|
||||
(bt:acquire-lock *message-queue-lock*)
|
||||
(push msg *message-queue*)
|
||||
(bt:release-lock *message-queue-lock*))
|
||||
|
||||
(defun message-queue-drain ()
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
(let ((msgs *incoming*))
|
||||
(setf *incoming* nil)
|
||||
msgs)))
|
||||
"Drain all messages from queue. Returns list in FIFO order."
|
||||
(bt:acquire-lock *message-queue-lock*)
|
||||
(let ((msgs (nreverse *message-queue*)))
|
||||
(setf *message-queue* nil)
|
||||
(bt:release-lock *message-queue-lock*)
|
||||
msgs))
|
||||
|
||||
(defun timestamp-now ()
|
||||
"Return a short HH:MM timestamp string."
|
||||
(multiple-value-bind (s m h) (decode-universal-time (get-universal-time))
|
||||
(declare (ignore s))
|
||||
(format nil "~2,'0d:~2,'0d" h m)))
|
||||
(defun reader-thread (stream)
|
||||
"Background thread: reads daemon messages and enqueues them."
|
||||
(loop while *is-running*
|
||||
do (let ((msg (read-message stream)))
|
||||
(when msg
|
||||
(message-queue-push msg)))))
|
||||
|
||||
(defun input-render (win)
|
||||
(clear win)
|
||||
(let ((text (coerce (reverse *input-buffer*) 'string)))
|
||||
(if (> (length text) 0)
|
||||
(add-string win (format nil "▶ ~a" text) :y 0 :x 1)
|
||||
(add-string win "▶ " :y 0 :x 1)))
|
||||
(refresh win))
|
||||
|
||||
(defun chat-render (win h &optional (offset 0))
|
||||
(when (and win (integerp h))
|
||||
(clear win)
|
||||
(box win 0 0)
|
||||
(let* ((view-height (- h 2))
|
||||
(history *chat-history*)
|
||||
(len (length history))
|
||||
(start (max 0 (- len view-height offset)))
|
||||
(end (min len (+ start view-height))))
|
||||
(loop for i from start below end
|
||||
for msg in (subseq history start end)
|
||||
for row from 1
|
||||
do (add-string win (format nil "│ ~a" msg) :y row :x 2)))
|
||||
(refresh win)))
|
||||
|
||||
(defun status-render (win)
|
||||
(when win
|
||||
(clear win)
|
||||
(box win 0 0)
|
||||
(let* ((status (if (and *stream* (open-stream-p *stream*)) "●" "○"))
|
||||
(msgs (length *chat-history*))
|
||||
(scroll-indicator (if (> *chat-scroll-pos* 0)
|
||||
(format nil " ↑~a" *chat-scroll-pos*)
|
||||
""))
|
||||
(time (timestamp-now)))
|
||||
(add-string win (format nil "│ ~a PASSEPARTOUT [~a msgs]~a ~a"
|
||||
status msgs scroll-indicator time)
|
||||
:y 1 :x 2)))
|
||||
(refresh win))
|
||||
(defun input-text ()
|
||||
"Convert input buffer to string."
|
||||
(coerce (reverse *input-buffer*) 'string))
|
||||
|
||||
(defun input-backspace ()
|
||||
(pop *input-buffer*))
|
||||
|
||||
(defun input-history-push (cmd)
|
||||
(when (> (length cmd) 0)
|
||||
(setf *input-history* (cons cmd *input-history*))
|
||||
(setf *input-history-pos* nil)))
|
||||
|
||||
(defun input-history-nav (direction)
|
||||
(let ((len (length *input-history*)))
|
||||
(if (= len 0)
|
||||
nil
|
||||
(case direction
|
||||
(:up
|
||||
(let ((pos (if *input-history-pos*
|
||||
(min (1+ *input-history-pos*) (1- len))
|
||||
0)))
|
||||
(setf *input-history-pos* pos)
|
||||
(nth pos *input-history*)))
|
||||
(:down
|
||||
(if *input-history-pos*
|
||||
(if (= *input-history-pos* 0)
|
||||
(progn (setf *input-history-pos* nil) nil)
|
||||
(let ((pos (1- *input-history-pos*)))
|
||||
(setf *input-history-pos* pos)
|
||||
(nth pos *input-history*)))
|
||||
nil))))))
|
||||
(when *input-buffer* (pop *input-buffer*)))
|
||||
|
||||
(defun input-submit (stream)
|
||||
(let ((cmd (coerce (reverse *input-buffer*) 'string)))
|
||||
(setf *input-buffer* nil)
|
||||
(setf *input-history-pos* nil)
|
||||
(log-debug "SUBMITTING: '~a'" cmd)
|
||||
(when (> (length cmd) 0)
|
||||
(input-history-push cmd)
|
||||
(let* ((ts (timestamp-now))
|
||||
(display (format nil "⬆ [~a] ~a" ts cmd)))
|
||||
(push display *chat-history*))
|
||||
(handler-case
|
||||
(progn
|
||||
(if (and stream (open-stream-p stream))
|
||||
(let* ((msg (list :TYPE :EVENT
|
||||
:META (list :SOURCE :tui)
|
||||
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))
|
||||
(payload (format nil "~s" msg))
|
||||
(len (length payload)))
|
||||
(format stream "~6,'0x~a" len payload)
|
||||
(finish-output stream)
|
||||
(log-debug "SENT WIRE: ~a" payload))
|
||||
(push "⬇ [--:--] ERROR: Not connected." *chat-history*)))
|
||||
(error (c)
|
||||
(log-debug "SEND ERROR: ~a" c)
|
||||
(push (format nil "⬇ [--:--] ERROR: ~a" c) *chat-history*)
|
||||
(setf *is-running* nil))))
|
||||
(when (string= cmd "/exit") (setf *is-running* nil))
|
||||
(when (string= cmd "/clear") (setf *chat-history* nil) (setf *chat-scroll-pos* 0))))
|
||||
"Send current input buffer content to daemon."
|
||||
(let ((text (string-trim '(#\Space) (input-text))))
|
||||
(when (> (length text) 0)
|
||||
(push text *input-history*)
|
||||
(setf *input-history-pos* 0)
|
||||
(send-message stream text)
|
||||
(push (cons :sent text) *chat-history*)
|
||||
(setf *input-buffer* nil))))
|
||||
|
||||
(defun reader-start (stream)
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(loop while *is-running* do
|
||||
(handler-case
|
||||
(let* ((len-buf (make-string 6))
|
||||
(count (read-sequence len-buf stream)))
|
||||
(if (= count 6)
|
||||
(let* ((msg-len (parse-integer len-buf :radix 16))
|
||||
(msg-buf (make-string msg-len)))
|
||||
(read-sequence msg-buf stream)
|
||||
(log-debug "DAEMON MSG: ~a" msg-buf)
|
||||
(let* ((msg (read-from-string msg-buf))
|
||||
(payload (getf msg :payload))
|
||||
(ts (timestamp-now)))
|
||||
(cond
|
||||
((eq (getf payload :action) :handshake)
|
||||
(message-queue-push (format nil "⬇ [~a] * Connected *" ts)))
|
||||
(t
|
||||
(let ((text (or (getf payload :text) (format nil "~a" payload))))
|
||||
(message-queue-push (format nil "⬇ [~a] ~a" ts text)))))))
|
||||
(sleep 0.05)))
|
||||
(error (c)
|
||||
(when *is-running*
|
||||
(log-debug "READER ERROR: ~a" c)
|
||||
(message-queue-push "⬇ [--:--] ERROR: Connection lost.")
|
||||
(setf *is-running* nil))))))
|
||||
:name "passepartout-tui-reader"))
|
||||
(defun input-history-nav (dir)
|
||||
"Navigate input history. Returns new value or nil."
|
||||
(let ((len (length *input-history*)))
|
||||
(when (= len 0) (return-from input-history-nav nil))
|
||||
(case dir
|
||||
(:up (if (< *input-history-pos* (1- len))
|
||||
(incf *input-history-pos*)
|
||||
nil))
|
||||
(:down (if (> *input-history-pos* 0)
|
||||
(decf *input-history-pos*)
|
||||
(progn (setf *input-history-pos* 0) nil)))))
|
||||
(when (>= *input-history-pos* 0)
|
||||
(nth *input-history-pos* *input-history*)))
|
||||
|
||||
(defun main ()
|
||||
(log-debug "=== START ===")
|
||||
(defun timestamp ()
|
||||
"Return HH:MM timestamp string."
|
||||
(multiple-value-bind (h m) (get-decoded-time)
|
||||
(format nil "~2,'0d:~2,'0d" h m)))
|
||||
|
||||
(defun status-render (win)
|
||||
"Draw the status bar."
|
||||
(let ((h (or (height win) 3))
|
||||
(w (or (width win) 78)))
|
||||
(clear win)
|
||||
(box win 0 0)
|
||||
(add-string win 1 1 (format nil " Passepartout ~a [~a] msgs:~a scroll:~a"
|
||||
(if *stream* "● Connected" "○ Disconnected")
|
||||
(ecase *tui-mode* (:chat "CHAT") (:config "CONFIG"))
|
||||
(length *chat-history*)
|
||||
(if (> *chat-scroll-pos* 0) (format nil "~a↑" *chat-scroll-pos*) "0")))
|
||||
(add-string win 2 1 (format nil " ~a" (timestamp)))
|
||||
(refresh win)))
|
||||
|
||||
(defun chat-render (win h)
|
||||
"Draw the chat history within WIN of height H."
|
||||
(clear win)
|
||||
(box win 0 0)
|
||||
(let* ((max-lines (- h 2))
|
||||
(total (length *chat-history*))
|
||||
(start (max 0 (- total max-lines *chat-scroll-pos*)))
|
||||
(y 1))
|
||||
(loop for i from start below total
|
||||
do (let ((entry (nth i *chat-history*)))
|
||||
(when (and (< y (1- h)) (car entry))
|
||||
(let* ((dir (car entry))
|
||||
(text (cdr entry))
|
||||
(prefix (if (eq dir :sent) "⬆" "⬇"))
|
||||
(label (format nil "~a [~a] ~a" prefix (timestamp) text)))
|
||||
(add-string win 1 y label)
|
||||
(incf y))))))
|
||||
(refresh win))
|
||||
|
||||
(defun input-render (win)
|
||||
"Draw the input line."
|
||||
(clear win)
|
||||
(add-string win 0 0 (input-text))
|
||||
(refresh win))
|
||||
|
||||
(defun config-render (win)
|
||||
"Draw the config mini-buffer panel."
|
||||
(let ((w (or (width win) 78)))
|
||||
(clear win)
|
||||
(box win 0 0)
|
||||
(add-string win 1 1 "[1] Providers [2] Cascade [3] Models [4] View [q] Back")
|
||||
(add-string win 2 1 (format nil "~a providers configured (PROVIDER_CASCADE: ~a)"
|
||||
(count-if (lambda (p) (provider-available-p p))
|
||||
(mapcar #'car *provider-configs*))
|
||||
(mapcar (lambda (k) (string-downcase (string k))) *provider-cascade*)))
|
||||
(refresh win)))
|
||||
|
||||
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
|
||||
"Connect to daemon."
|
||||
(handler-case
|
||||
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
|
||||
(error (e) (format t "Offline: ~a~%" e) (return-from main)))
|
||||
(setf *stream* (usocket:socket-stream *socket*))
|
||||
(let ((s (usocket:socket-connect host port :element-type '(unsigned-byte 8))))
|
||||
(setf *stream* (usocket:socket-stream s))
|
||||
(setf *message-queue* nil)
|
||||
(bt:make-thread (lambda () (reader-thread *stream*)) :name "tui-reader")
|
||||
(push (cons :system "* Connected *") *chat-history*)
|
||||
(log-message "Connected to ~a:~a" host port)
|
||||
t)
|
||||
(error (c)
|
||||
(push (cons :system (format nil "* Connection failed: ~a *" c)) *chat-history*)
|
||||
nil)))
|
||||
|
||||
(unwind-protect
|
||||
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t)
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
(status-h 3)
|
||||
(input-h 1)
|
||||
(chat-h (- h status-h input-h 1))
|
||||
(status-win (make-instance 'window :height status-h :width (- w 2) :y 0 :x 1))
|
||||
(chat-win (make-instance 'window :height chat-h :width (- w 2) :y status-h :x 1))
|
||||
(input-win (make-instance 'window :height input-h :width (- w 2) :y (- h input-h 1) :x 1)))
|
||||
(setf (input-blocking input-win) nil)
|
||||
(setf (function-keys-enabled-p input-win) t)
|
||||
(setf (function-keys-enabled-p chat-win) t)
|
||||
(reader-start *stream*)
|
||||
(loop :while *is-running* :do
|
||||
(let ((msgs (message-queue-drain)))
|
||||
(when msgs
|
||||
(dolist (m msgs) (push m *chat-history*))
|
||||
(when (> *chat-scroll-pos* 0)
|
||||
(incf *chat-scroll-pos* (length msgs)))
|
||||
(chat-render chat-win chat-h *chat-scroll-pos*)
|
||||
(status-render status-win)))
|
||||
(let ((ch (get-char input-win)))
|
||||
(when (and ch (not (equal ch -1)))
|
||||
(log-debug "KEY: ~s" ch)
|
||||
(cond
|
||||
;; Enter / Return — submit
|
||||
((or (eql ch 10) (eql ch 13) (eq ch :enter)
|
||||
(eql ch #\Newline) (eql ch #\Return))
|
||||
(setf *chat-scroll-pos* 0)
|
||||
(input-submit *stream*)
|
||||
(chat-render chat-win chat-h 0)
|
||||
(status-render status-win))
|
||||
;; Backspace
|
||||
((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
|
||||
(input-backspace)
|
||||
(input-render input-win))
|
||||
;; Up arrow — history back
|
||||
((or (eq ch :up) (eql ch 259))
|
||||
(let ((prev (input-history-nav :up)))
|
||||
(when prev
|
||||
(setf *input-buffer* (reverse (coerce prev 'list)))
|
||||
(input-render input-win))))
|
||||
;; Down arrow — history forward
|
||||
((or (eq ch :down) (eql ch 258))
|
||||
(let ((next (input-history-nav :down)))
|
||||
(if next
|
||||
(setf *input-buffer* (reverse (coerce next 'list)))
|
||||
(setf *input-buffer* nil))
|
||||
(input-render input-win)))
|
||||
;; Page Up — scroll chat back
|
||||
((or (eq ch :ppage) (eql ch 339))
|
||||
(let* ((hist-len (length *chat-history*))
|
||||
(view-h (- chat-h 2))
|
||||
(max-offset (max 0 (- hist-len view-h))))
|
||||
(setf *chat-scroll-pos*
|
||||
(min (+ *chat-scroll-pos* view-h) max-offset))
|
||||
(chat-render chat-win chat-h *chat-scroll-pos*)
|
||||
(status-render status-win)))
|
||||
;; Page Down — scroll chat forward
|
||||
((or (eq ch :npage) (eql ch 338))
|
||||
(setf *chat-scroll-pos* (max 0 (- *chat-scroll-pos* (- chat-h 2))))
|
||||
(chat-render chat-win chat-h *chat-scroll-pos*)
|
||||
(status-render status-win))
|
||||
;; Printable character
|
||||
((characterp ch)
|
||||
(push ch *input-buffer*)
|
||||
(input-render input-win))
|
||||
;; Integer key code → character
|
||||
((integerp ch)
|
||||
(let ((converted (code-char ch)))
|
||||
(when (graphic-char-p converted)
|
||||
(push converted *input-buffer*)
|
||||
(input-render input-win))))))
|
||||
;; Re-render input on every tick (no key = buffer unchanged)
|
||||
(input-render input-win))
|
||||
(sleep 0.01))))
|
||||
(setf *is-running* nil)
|
||||
(when *socket* (ignore-errors (usocket:socket-close *socket*)))))
|
||||
(defun disconnect-daemon ()
|
||||
"Disconnect from daemon."
|
||||
(when *stream*
|
||||
(ignore-errors (close *stream*))
|
||||
(setf *stream* nil)
|
||||
(push (cons :system "* Disconnected *") *chat-history*)))
|
||||
|
||||
(defun tui-main ()
|
||||
"Entry point for the TUI client."
|
||||
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
(input-h 1)
|
||||
(config-h 0)
|
||||
(chat-h (- h input-h config-h 3))
|
||||
(status-win (make-instance 'window :height 3 :width (- w 2) :y 0 :x 1))
|
||||
(chat-win (make-instance 'window :height chat-h :width (- w 2) :y 3 :x 1))
|
||||
(config-win (make-instance 'window :height 0 :width (- w 2) :y (- h input-h config-h 1) :x 1))
|
||||
(input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 1) :x 1)))
|
||||
(setf *is-running* t *tui-mode* :chat *input-buffer* nil)
|
||||
(connect-daemon)
|
||||
(setf *chat-scroll-pos* 0)
|
||||
(status-render status-win)
|
||||
(chat-render chat-win chat-h)
|
||||
(input-render input-win)
|
||||
(loop :while *is-running* :do
|
||||
;; drain message queue
|
||||
(dolist (msg (message-queue-drain))
|
||||
(push (cons :received (let ((p (proto-get msg :payload)))
|
||||
(or (proto-get p :text) (format nil "~a" msg))))
|
||||
*chat-history*))
|
||||
;; handle input
|
||||
(let ((ch (get-char input-win)))
|
||||
(when (and ch (not (equal ch -1)))
|
||||
(cond
|
||||
;; F2: toggle config panel
|
||||
((or (eq ch :f2) (and (integerp ch) (= ch 265)))
|
||||
(if (eq *tui-mode* :chat)
|
||||
(progn
|
||||
(setf *tui-mode* :config)
|
||||
(setf *config-panel-height* 10)
|
||||
(setf config-h *config-panel-height*)
|
||||
(setf chat-h (- h input-h config-h 3))
|
||||
(resize chat-win chat-h (- w 2))
|
||||
(resize config-win config-h (- w 2))
|
||||
(config-render config-win))
|
||||
(progn
|
||||
(setf *tui-mode* :chat)
|
||||
(setf config-h 0)
|
||||
(setf chat-h (- h input-h 3))
|
||||
(resize chat-win chat-h (- w 2))
|
||||
(resize config-win 0 (- w 2))
|
||||
(chat-render chat-win chat-h)))
|
||||
(status-render status-win))
|
||||
;; Config mode key handling
|
||||
((eq *tui-mode* :config)
|
||||
(cond
|
||||
((or (eql ch #\q) (eql ch #\Q))
|
||||
(setf *tui-mode* :chat config-h 0 chat-h (- h input-h 3))
|
||||
(resize chat-win chat-h (- w 2))
|
||||
(resize config-win 0 (- w 2))
|
||||
(chat-render chat-win chat-h)
|
||||
(status-render status-win))
|
||||
((eql ch #\1)
|
||||
(config-render config-win)
|
||||
(add-string config-win 3 1 "Providers: check daemon log for status.")
|
||||
(refresh config-win))
|
||||
((eql ch #\2)
|
||||
(config-render config-win)
|
||||
(add-string config-win 3 1 (format nil "Cascade: ~a" *provider-cascade*))
|
||||
(refresh config-win))
|
||||
((eql ch #\3)
|
||||
(config-render config-win)
|
||||
(add-string config-win 3 1 "Models: see recommendations per slot.")
|
||||
(refresh config-win))
|
||||
((eql ch #\4)
|
||||
(config-render config-win)
|
||||
(add-string config-win 3 1 (format nil "Active providers: ~a"
|
||||
(loop for k being the hash-keys of *probabilistic-backends* collect k)))
|
||||
(refresh config-win))))
|
||||
(status-render status-win))
|
||||
;; Chat mode key handling
|
||||
(t
|
||||
(cond
|
||||
;; Enter/Return submit
|
||||
((or (eql ch 10) (eql ch 13) (eq ch :enter) (eql ch #\Newline) (eql ch #\Return))
|
||||
(setf *chat-scroll-pos* 0)
|
||||
(input-submit *stream*)
|
||||
(chat-render chat-win chat-h)
|
||||
(input-render input-win)
|
||||
(status-render status-win))
|
||||
;; Backspace
|
||||
((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
|
||||
(input-backspace)
|
||||
(input-render input-win))
|
||||
;; Up arrow
|
||||
((or (eq ch :up) (eql ch 259))
|
||||
(let ((prev (input-history-nav :up)))
|
||||
(when prev
|
||||
(setf *input-buffer* (reverse (coerce prev 'list)))
|
||||
(input-render input-win))))
|
||||
;; Down arrow
|
||||
((or (eq ch :down) (eql ch 258))
|
||||
(let ((next (input-history-nav :down)))
|
||||
(if next
|
||||
(setf *input-buffer* (reverse (coerce next 'list)))
|
||||
(setf *input-buffer* nil))
|
||||
(input-render input-win)))
|
||||
;; Page Up
|
||||
((or (eq ch :ppage) (eql ch 339))
|
||||
(setf *chat-scroll-pos* (+ *chat-scroll-pos* 10))
|
||||
(chat-render chat-win chat-h)
|
||||
(status-render status-win))
|
||||
;; Page Down
|
||||
((or (eq ch :npage) (eql ch 338))
|
||||
(setf *chat-scroll-pos* (max 0 (- *chat-scroll-pos* 10)))
|
||||
(chat-render chat-win chat-h)
|
||||
(status-render status-win))
|
||||
;; Printable character
|
||||
((characterp ch)
|
||||
(push ch *input-buffer*)
|
||||
(input-render input-win))
|
||||
;; Integer key code
|
||||
((integerp ch)
|
||||
(let ((converted (code-char ch)))
|
||||
(when (and converted (graphic-char-p converted))
|
||||
(push converted *input-buffer*)
|
||||
(input-render input-win))))))))
|
||||
(refresh scr)
|
||||
(sleep 0.01))
|
||||
(disconnect-daemon))))
|
||||
|
||||
@@ -60,4 +60,10 @@
|
||||
(:background
|
||||
'((:id "meta-llama/llama-3.2-3b-instruct:free" :name "Llama 3.2 3B" :context 131072 :free t :note "Small, fast, efficient")
|
||||
(:id "liquid/lfm-2.5-1.2b-instruct:free" :name "LFM 2.5 1.2B" :context 32768 :free t :note "Ultra-compact, edge-ready")))
|
||||
(t '((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Safe fallback")))))
|
||||
(t '((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Safe fallback")))))
|
||||
|
||||
(defvar *slot-descriptions*
|
||||
'((:code . "Code generation, refactoring, debugging. Needs strong reasoning and large context.\nRecommend: Qwen3 Coder (free, 35B active) or Laguna M.1 (coding agent).")
|
||||
(:chat . "Casual conversation, Q&A, creative writing. Prefer balanced quality, low latency.\nRecommend: Llama 3.3 70B (strong generalist) or Gemma 4 31B (thinking mode).")
|
||||
(:plan . "Strategic planning, architecture design, complex multi-step reasoning.\nRecommend: Owl Alpha (free, tool use, 1M ctx) or Hermes 3 405B (strongest free reasoning).")
|
||||
(:background . "Heartbeat summaries, delegation responses, tool output filtering. Must be small + fast.\nRecommend: Llama 3.2 3B (131K ctx, fast) or LFM 2.5 1.2B (edge-ready).")))
|
||||
|
||||
@@ -81,6 +81,29 @@
|
||||
(member (car e) '(:local :ollama)))
|
||||
*provider-configs*))))))
|
||||
|
||||
(defun test-provider-connection (provider &optional api-key)
|
||||
"Test a provider API key by hitting its models endpoint.
|
||||
Returns (:ok) on success, (:fail reason) on failure.
|
||||
If API-KEY is nil, reads from environment."
|
||||
(let* ((config (provider-config provider))
|
||||
(base-url (getf config :base-url))
|
||||
(key-env (getf config :key-env))
|
||||
(url-env (getf config :url-env))
|
||||
(key (or api-key (when key-env (uiop:getenv key-env)))))
|
||||
(handler-case
|
||||
(let ((url (if url-env
|
||||
(let ((host (or (uiop:getenv url-env) "")))
|
||||
(format nil "http://~a/api/tags" host))
|
||||
(format nil "~a/models" (or base-url "")))))
|
||||
(if key-env
|
||||
(progn (dex:get url :headers `(("Authorization" . ,(format nil "Bearer ~a" key)))
|
||||
:connect-timeout 5 :read-timeout 10)
|
||||
'(:ok))
|
||||
(if url-env
|
||||
(progn (dex:get url :connect-timeout 5 :read-timeout 10) '(:ok))
|
||||
'(:fail "No URL source for this provider"))))
|
||||
(error (c) `(:fail ,(format nil "~a" c))))))
|
||||
|
||||
(provider-register-all)
|
||||
(provider-cascade-initialize)
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
(in-package :passepartout)
|
||||
|
||||
(defvar *model-cascade-code* nil
|
||||
"Cascade for :code tasks: ((:provider . \"model\") ...)")
|
||||
"Cascade for :code tasks: ((:ollama . \"model\") ...)")
|
||||
|
||||
(defvar *model-cascade-plan* nil
|
||||
"Cascade for :plan tasks.")
|
||||
@@ -12,8 +12,8 @@
|
||||
(defvar *model-cascade-background* nil
|
||||
"Cascade for background tasks (heartbeat, delegation).")
|
||||
|
||||
(defvar *local-backends* nil
|
||||
"Backend keywords considered local (privacy-safe). Set via LOCAL_BACKENDS env var.")
|
||||
(defvar *local-backends* '(:ollama :llama-cpp)
|
||||
"Backend keywords considered local (privacy-safe).")
|
||||
|
||||
(defun model-classify-complexity (text)
|
||||
"Classify TEXT into :code, :plan, or :chat."
|
||||
@@ -53,7 +53,7 @@ Returns model name or :skip."
|
||||
;; Quadrant: background tasks use background cascade
|
||||
(if (member sensor '(:heartbeat :delegation :tool-output :loop-error))
|
||||
(let ((entry (car (or *model-cascade-background*
|
||||
'((:openrouter . "meta-llama/llama-3.2-3b-instruct:free"))))))
|
||||
'((:ollama . "phi-2"))))))
|
||||
(cdr entry))
|
||||
;; Foreground: classify complexity, use slot cascade
|
||||
(let* ((slot (model-classify-complexity text))
|
||||
@@ -62,7 +62,7 @@ Returns model name or :skip."
|
||||
(:plan *model-cascade-plan*)
|
||||
(t *model-cascade-chat*)))
|
||||
(entry (model-cascade-find
|
||||
(or cascade '((:openrouter . "meta-llama/llama-3.3-70b-instruct:free"))) backend)))
|
||||
(or cascade '((:ollama . "qwen2.5:14b"))) backend)))
|
||||
(if entry (cdr entry) nil)))))
|
||||
|
||||
(defun model-router-init ()
|
||||
@@ -79,7 +79,7 @@ Returns model name or :skip."
|
||||
(if env
|
||||
(mapcar (lambda (s) (intern (string-upcase (string-trim " " s)) :keyword))
|
||||
(uiop:split-string env :separator '(#\,)))
|
||||
nil))))
|
||||
'(:ollama :llama-cpp)))))
|
||||
(setf *model-selector* #'model-select)
|
||||
(log-message "MODEL-ROUTER: Initialized, selector=~a" *model-selector*))
|
||||
|
||||
|
||||
@@ -327,8 +327,7 @@ The validation step is critical: invalid Lisp in an org block would crash the lo
|
||||
(setf (gethash (symbol-name sym) seen) t)
|
||||
(incf exported)
|
||||
(let ((existing (find-symbol (symbol-name sym) target-pkg)))
|
||||
(when (and existing (not (eq existing sym)))
|
||||
(unintern existing target-pkg)))
|
||||
(when existing (unintern existing target-pkg)))
|
||||
(import sym target-pkg)
|
||||
(export sym target-pkg)))
|
||||
(log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
|
||||
@@ -376,10 +375,9 @@ The same jailed package and symbol export process applies.
|
||||
(setf (gethash (symbol-name sym) seen) t)
|
||||
(incf exported)
|
||||
(let ((existing (find-symbol (symbol-name sym) target-pkg)))
|
||||
(when (and existing (not (eq existing sym)))
|
||||
(unintern existing target-pkg)))
|
||||
(when existing (unintern existing target-pkg)))
|
||||
(import sym target-pkg)
|
||||
(export sym target-pkg)))
|
||||
(ignore-errors (export sym target-pkg))))
|
||||
(log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
|
||||
exported (package-name (find-package pkg-name))))
|
||||
(setf (skill-entry-status entry) :ready))
|
||||
|
||||
@@ -1,493 +1,339 @@
|
||||
#+TITLE: Passepartout TUI Client (Standalone)
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :tui:ux:client:
|
||||
#+TITLE: Passepartout TUI Client
|
||||
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-tui.lisp
|
||||
|
||||
* Overview: Architectural Intent
|
||||
* Architectural Intent
|
||||
|
||||
The TUI Client is a standalone ncurses application built on Croatoan that
|
||||
connects to the daemon via TCP. It provides a three-pane interface: a status
|
||||
bar at top, scrollable chat history in the middle, and a fixed input line at
|
||||
the bottom.
|
||||
The TUI Client is a Croatoan-based ncurses chat interface for Passepartout. It connects to the daemon over TCP, displays messages in a scrollable window, and provides a mini-buffer-style configuration panel (F2) for managing providers, cascade, and model picks.
|
||||
|
||||
Unlike the CLI gateway (which is a single request-response cycle), the TUI
|
||||
is a persistent connection. It maintains a background reader thread that
|
||||
listens for incoming messages from the daemon and enqueues them for display.
|
||||
This allows the agent to send messages to the user asynchronously — tool
|
||||
results, heartbeat notifications, and autonomous decisions appear in the
|
||||
chat window without the user having to ask.
|
||||
** Layout
|
||||
```
|
||||
┌─ Status bar (3 rows) ──────────────────────────────────┐
|
||||
├─ Chat area (expandable/contractable) ──────────────────┤
|
||||
├─ Config mini-buffer (0-12 rows, visible when F2 open) ─┤
|
||||
│ [1] Providers [2] Cascade [3] Models [4] View [q] │
|
||||
│ Provider Status Model │
|
||||
│ openrouter ✓ │
|
||||
│ groq ✓ │
|
||||
│ enter API key for openai: ████████ │
|
||||
├─ Input line (1 row) ───────────────────────────────────┤
|
||||
└────────────────────────────────────────────────────────┘
|
||||
```
|
||||
|
||||
* Implementation
|
||||
|
||||
** Package Context
|
||||
|
||||
The TUI lives in its own package (~passepartout.gateway-tui~) so it doesn't pollute the harness namespace. It depends on Croatoan (ncurses bindings), usocket (TCP client), and bordeaux-threads (background reader).
|
||||
|
||||
** State
|
||||
#+begin_src lisp
|
||||
(in-package :cl-user)
|
||||
(defpackage :passepartout.gateway-tui
|
||||
(:use :cl :croatoan :usocket :bordeaux-threads)
|
||||
(:export :main))
|
||||
(in-package :passepartout.gateway-tui)
|
||||
(in-package :passepartout)
|
||||
|
||||
(defvar *stream* nil "TCP stream to daemon")
|
||||
(defvar *input-buffer* nil "Current input line as reversed char list")
|
||||
(defvar *input-history* nil "Sent messages (newest first)")
|
||||
(defvar *input-history-pos* 0 "Position in input history for nav")
|
||||
(defvar *chat-history* nil "List of (direction . text) entries")
|
||||
(defvar *chat-scroll-pos* 0 "How many lines from bottom we scrolled up")
|
||||
(defvar *is-running* t "Main loop flag")
|
||||
(defvar *tui-mode* :chat "Current mode: :chat or :config")
|
||||
(defvar *config-selection* 0 "Selected menu item in config panel")
|
||||
(defvar *config-panel-height* 10 "Height of config panel when open")
|
||||
#+end_src
|
||||
|
||||
** Connection state
|
||||
|
||||
The daemon host and port. Defaults to localhost:9105.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
** Protocol helpers
|
||||
#+begin_src lisp
|
||||
(defvar *daemon-host* "localhost")
|
||||
(defun send-message (stream msg)
|
||||
"Send a framed s-expression over TCP."
|
||||
(let* ((sexp (format nil "(~a)" msg))
|
||||
(len (length sexp))
|
||||
(header (format nil "~6,'0x" len)))
|
||||
(write-sequence (babel:string-to-octets (concatenate 'string header sexp)) stream)
|
||||
(force-output stream)
|
||||
(log-message "SENT: ~a" sexp)))
|
||||
|
||||
(defun read-message (stream)
|
||||
"Read a framed s-expression from TCP."
|
||||
(handler-case
|
||||
(let* ((header (make-array 6 :element-type '(unsigned-byte 8)))
|
||||
(read (read-sequence header stream)))
|
||||
(when (< read 6) (return-from read-message nil))
|
||||
(let* ((hex (babel:octets-to-string header))
|
||||
(len (parse-integer hex :radix 16 :junk-allowed t))
|
||||
(buf (make-array len :element-type '(unsigned-byte 8))))
|
||||
(read-sequence buf stream)
|
||||
(read-from-string (babel:octets-to-string buf))))
|
||||
(error () nil)))
|
||||
#+end_src
|
||||
|
||||
** *daemon-port*
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
** Message queue (for background reader thread)
|
||||
#+begin_src lisp
|
||||
(defvar *daemon-port* 9105)
|
||||
#+end_src
|
||||
(defvar *message-queue* nil
|
||||
"List of incoming daemon messages from reader thread.")
|
||||
(defvar *message-queue-lock* (bt:make-lock "msg-queue-lock")
|
||||
"Lock for thread-safe queue access.")
|
||||
|
||||
** Socket and stream
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *socket* nil)
|
||||
#+end_src
|
||||
|
||||
** *stream*
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *stream* nil)
|
||||
#+end_src
|
||||
|
||||
** Chat history
|
||||
|
||||
Each message is a list ~(:text "..." :time ...)~ for structured rendering.
|
||||
The third value is the display string with timestamp prepended.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *chat-history* nil)
|
||||
#+end_src
|
||||
|
||||
** Chat scroll position
|
||||
|
||||
Offset from the bottom of the history. 0 = latest messages visible.
|
||||
Positive values scroll back. Protected by ~*queue-lock*~.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *chat-scroll-pos* 0)
|
||||
#+end_src
|
||||
|
||||
** Input buffer
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *input-buffer* nil)
|
||||
#+end_src
|
||||
|
||||
** Input history
|
||||
|
||||
Previous commands for recall via up/down arrows.
|
||||
|
||||
- ~*input-history*~: list of submitted command strings, newest first.
|
||||
- ~*input-history-pos*~: current position in the history list (0 = newest,
|
||||
nil = fresh input).
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *input-history* nil)
|
||||
(defvar *input-history-pos* nil)
|
||||
#+end_src
|
||||
|
||||
** Running flag
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *is-running* t)
|
||||
#+end_src
|
||||
|
||||
** Incoming message queue
|
||||
|
||||
Thread-safe queue for messages received by the background reader.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *queue-lock* (bt:make-lock "incoming-queue-lock"))
|
||||
#+end_src
|
||||
|
||||
** *incoming*
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *incoming* nil)
|
||||
#+end_src
|
||||
|
||||
** Utility functions
|
||||
|
||||
*** Debug logging
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun log-debug (msg &rest args)
|
||||
(ignore-errors
|
||||
(with-open-file (s "/tmp/passepartout-tui-debug.log" :direction :output :if-exists :append :if-does-not-exist :create)
|
||||
(format s "[~a] " (get-universal-time))
|
||||
(apply #'format s msg args)
|
||||
(terpri s)
|
||||
(finish-output s))))
|
||||
#+end_src
|
||||
|
||||
*** Message queue (message-queue-push)
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun message-queue-push (msg)
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
(setf *incoming* (append *incoming* (list msg)))))
|
||||
#+end_src
|
||||
(bt:acquire-lock *message-queue-lock*)
|
||||
(push msg *message-queue*)
|
||||
(bt:release-lock *message-queue-lock*))
|
||||
|
||||
*** Message queue (message-queue-drain)
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun message-queue-drain ()
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
(let ((msgs *incoming*))
|
||||
(setf *incoming* nil)
|
||||
msgs)))
|
||||
#+end_src
|
||||
"Drain all messages from queue. Returns list in FIFO order."
|
||||
(bt:acquire-lock *message-queue-lock*)
|
||||
(let ((msgs (nreverse *message-queue*)))
|
||||
(setf *message-queue* nil)
|
||||
(bt:release-lock *message-queue-lock*)
|
||||
msgs))
|
||||
|
||||
*** Timestamp formatting
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun timestamp-now ()
|
||||
"Return a short HH:MM timestamp string."
|
||||
(multiple-value-bind (s m h) (decode-universal-time (get-universal-time))
|
||||
(declare (ignore s))
|
||||
(format nil "~2,'0d:~2,'0d" h m)))
|
||||
(defun reader-thread (stream)
|
||||
"Background thread: reads daemon messages and enqueues them."
|
||||
(loop while *is-running*
|
||||
do (let ((msg (read-message stream)))
|
||||
(when msg
|
||||
(message-queue-push msg)))))
|
||||
#+end_src
|
||||
|
||||
** Input rendering
|
||||
|
||||
Draws the input line with a ~▶~ prompt. Handles the case where the input
|
||||
buffer is empty (shows a dimmed hint).
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun input-render (win)
|
||||
(defun input-text ()
|
||||
"Convert input buffer to string."
|
||||
(coerce (reverse *input-buffer*) 'string))
|
||||
|
||||
(defun input-backspace ()
|
||||
(when *input-buffer* (pop *input-buffer*)))
|
||||
|
||||
(defun input-submit (stream)
|
||||
"Send current input buffer content to daemon."
|
||||
(let ((text (string-trim '(#\Space) (input-text))))
|
||||
(when (> (length text) 0)
|
||||
(push text *input-history*)
|
||||
(setf *input-history-pos* 0)
|
||||
(send-message stream text)
|
||||
(push (cons :sent text) *chat-history*)
|
||||
(setf *input-buffer* nil))))
|
||||
|
||||
(defun input-history-nav (dir)
|
||||
"Navigate input history. Returns new value or nil."
|
||||
(let ((len (length *input-history*)))
|
||||
(when (= len 0) (return-from input-history-nav nil))
|
||||
(case dir
|
||||
(:up (if (< *input-history-pos* (1- len))
|
||||
(incf *input-history-pos*)
|
||||
nil))
|
||||
(:down (if (> *input-history-pos* 0)
|
||||
(decf *input-history-pos*)
|
||||
(progn (setf *input-history-pos* 0) nil)))))
|
||||
(when (>= *input-history-pos* 0)
|
||||
(nth *input-history-pos* *input-history*)))
|
||||
#+end_src
|
||||
|
||||
** Display helpers
|
||||
#+begin_src lisp
|
||||
(defun timestamp ()
|
||||
"Return HH:MM timestamp string."
|
||||
(multiple-value-bind (h m) (get-decoded-time)
|
||||
(format nil "~2,'0d:~2,'0d" h m)))
|
||||
|
||||
(defun status-render (win)
|
||||
"Draw the status bar."
|
||||
(let ((h (or (height win) 3))
|
||||
(w (or (width win) 78)))
|
||||
(clear win)
|
||||
(box win 0 0)
|
||||
(add-string win 1 1 (format nil " Passepartout ~a [~a] msgs:~a scroll:~a"
|
||||
(if *stream* "● Connected" "○ Disconnected")
|
||||
(ecase *tui-mode* (:chat "CHAT") (:config "CONFIG"))
|
||||
(length *chat-history*)
|
||||
(if (> *chat-scroll-pos* 0) (format nil "~a↑" *chat-scroll-pos*) "0")))
|
||||
(add-string win 2 1 (format nil " ~a" (timestamp)))
|
||||
(refresh win)))
|
||||
|
||||
(defun chat-render (win h)
|
||||
"Draw the chat history within WIN of height H."
|
||||
(clear win)
|
||||
(let ((text (coerce (reverse *input-buffer*) 'string)))
|
||||
(if (> (length text) 0)
|
||||
(add-string win (format nil "▶ ~a" text) :y 0 :x 1)
|
||||
(add-string win "▶ " :y 0 :x 1)))
|
||||
(box win 0 0)
|
||||
(let* ((max-lines (- h 2))
|
||||
(total (length *chat-history*))
|
||||
(start (max 0 (- total max-lines *chat-scroll-pos*)))
|
||||
(y 1))
|
||||
(loop for i from start below total
|
||||
do (let ((entry (nth i *chat-history*)))
|
||||
(when (and (< y (1- h)) (car entry))
|
||||
(let* ((dir (car entry))
|
||||
(text (cdr entry))
|
||||
(prefix (if (eq dir :sent) "⬆" "⬇"))
|
||||
(label (format nil "~a [~a] ~a" prefix (timestamp) text)))
|
||||
(add-string win 1 y label)
|
||||
(incf y))))))
|
||||
(refresh win))
|
||||
|
||||
(defun input-render (win)
|
||||
"Draw the input line."
|
||||
(clear win)
|
||||
(add-string win 0 0 (input-text))
|
||||
(refresh win))
|
||||
#+end_src
|
||||
|
||||
** Rendering (chat-render / status-render)
|
||||
|
||||
*** Chat history renderer
|
||||
|
||||
Renders the chat history with scroll support. ~offset~ is the number of
|
||||
lines from the bottom to skip (0 = newest visible). Each message is shown
|
||||
with its timestamp.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
** Config panel rendering
|
||||
#+begin_src lisp
|
||||
(defun chat-render (win h &optional (offset 0))
|
||||
(when (and win (integerp h))
|
||||
(defun config-render (win)
|
||||
"Draw the config mini-buffer panel."
|
||||
(let ((w (or (width win) 78)))
|
||||
(clear win)
|
||||
(box win 0 0)
|
||||
(let* ((view-height (- h 2))
|
||||
(history *chat-history*)
|
||||
(len (length history))
|
||||
(start (max 0 (- len view-height offset)))
|
||||
(end (min len (+ start view-height))))
|
||||
(loop for i from start below end
|
||||
for msg in (subseq history start end)
|
||||
for row from 1
|
||||
do (add-string win (format nil "│ ~a" msg) :y row :x 2)))
|
||||
(add-string win 1 1 "[1] Providers [2] Cascade [3] Models [4] View [q] Back")
|
||||
(add-string win 2 1 (format nil "~a providers configured (PROVIDER_CASCADE: ~a)"
|
||||
(count-if (lambda (p) (provider-available-p p))
|
||||
(mapcar #'car *provider-configs*))
|
||||
(mapcar (lambda (k) (string-downcase (string k))) *provider-cascade*)))
|
||||
(refresh win)))
|
||||
#+end_src
|
||||
|
||||
*** Status bar renderer
|
||||
|
||||
Draws a compact status line showing connection status, message count, and
|
||||
scroll indicator.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
** Connection
|
||||
#+begin_src lisp
|
||||
(defun status-render (win)
|
||||
(when win
|
||||
(clear win)
|
||||
(box win 0 0)
|
||||
(let* ((status (if (and *stream* (open-stream-p *stream*)) "●" "○"))
|
||||
(msgs (length *chat-history*))
|
||||
(scroll-indicator (if (> *chat-scroll-pos* 0)
|
||||
(format nil " ↑~a" *chat-scroll-pos*)
|
||||
""))
|
||||
(time (timestamp-now)))
|
||||
(add-string win (format nil "│ ~a PASSEPARTOUT [~a msgs]~a ~a"
|
||||
status msgs scroll-indicator time)
|
||||
:y 1 :x 2)))
|
||||
(refresh win))
|
||||
#+end_src
|
||||
|
||||
** Input handling
|
||||
|
||||
*** Handle backspace
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun input-backspace ()
|
||||
(pop *input-buffer*))
|
||||
#+end_src
|
||||
|
||||
*** Save current buffer to history
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun input-history-push (cmd)
|
||||
(when (> (length cmd) 0)
|
||||
(setf *input-history* (cons cmd *input-history*))
|
||||
(setf *input-history-pos* nil)))
|
||||
#+end_src
|
||||
|
||||
*** Navigate input history
|
||||
|
||||
Moves ~*input-history-pos*~ backward (up) or forward (down). Returns the
|
||||
appropriate history entry, or nil if at the end.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun input-history-nav (direction)
|
||||
(let ((len (length *input-history*)))
|
||||
(if (= len 0)
|
||||
nil
|
||||
(case direction
|
||||
(:up
|
||||
(let ((pos (if *input-history-pos*
|
||||
(min (1+ *input-history-pos*) (1- len))
|
||||
0)))
|
||||
(setf *input-history-pos* pos)
|
||||
(nth pos *input-history*)))
|
||||
(:down
|
||||
(if *input-history-pos*
|
||||
(if (= *input-history-pos* 0)
|
||||
(progn (setf *input-history-pos* nil) nil)
|
||||
(let ((pos (1- *input-history-pos*)))
|
||||
(setf *input-history-pos* pos)
|
||||
(nth pos *input-history*)))
|
||||
nil))))))
|
||||
#+end_src
|
||||
|
||||
*** Handle return
|
||||
|
||||
Sends the accumulated input as a framed protocol message to the daemon.
|
||||
Also handles ~/exit~ and ~/clear~ client-side commands.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun input-submit (stream)
|
||||
(let ((cmd (coerce (reverse *input-buffer*) 'string)))
|
||||
(setf *input-buffer* nil)
|
||||
(setf *input-history-pos* nil)
|
||||
(log-debug "SUBMITTING: '~a'" cmd)
|
||||
(when (> (length cmd) 0)
|
||||
(input-history-push cmd)
|
||||
(let* ((ts (timestamp-now))
|
||||
(display (format nil "⬆ [~a] ~a" ts cmd)))
|
||||
(push display *chat-history*))
|
||||
(handler-case
|
||||
(progn
|
||||
(if (and stream (open-stream-p stream))
|
||||
(let* ((msg (list :TYPE :EVENT
|
||||
:META (list :SOURCE :tui)
|
||||
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))
|
||||
(payload (format nil "~s" msg))
|
||||
(len (length payload)))
|
||||
(format stream "~6,'0x~a" len payload)
|
||||
(finish-output stream)
|
||||
(log-debug "SENT WIRE: ~a" payload))
|
||||
(push "⬇ [--:--] ERROR: Not connected." *chat-history*)))
|
||||
(error (c)
|
||||
(log-debug "SEND ERROR: ~a" c)
|
||||
(push (format nil "⬇ [--:--] ERROR: ~a" c) *chat-history*)
|
||||
(setf *is-running* nil))))
|
||||
(when (string= cmd "/exit") (setf *is-running* nil))
|
||||
(when (string= cmd "/clear") (setf *chat-history* nil) (setf *chat-scroll-pos* 0))))
|
||||
#+end_src
|
||||
|
||||
** Background Reader (reader-start)
|
||||
|
||||
A dedicated thread that continuously reads framed messages from the daemon's
|
||||
TCP stream. Messages are parsed and enqueued with timestamps for the main
|
||||
loop to display.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun reader-start (stream)
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(loop while *is-running* do
|
||||
(handler-case
|
||||
(let* ((len-buf (make-string 6))
|
||||
(count (read-sequence len-buf stream)))
|
||||
(if (= count 6)
|
||||
(let* ((msg-len (parse-integer len-buf :radix 16))
|
||||
(msg-buf (make-string msg-len)))
|
||||
(read-sequence msg-buf stream)
|
||||
(log-debug "DAEMON MSG: ~a" msg-buf)
|
||||
(let* ((msg (read-from-string msg-buf))
|
||||
(payload (getf msg :payload))
|
||||
(ts (timestamp-now)))
|
||||
(cond
|
||||
((eq (getf payload :action) :handshake)
|
||||
(message-queue-push (format nil "⬇ [~a] * Connected *" ts)))
|
||||
(t
|
||||
(let ((text (or (getf payload :text) (format nil "~a" payload))))
|
||||
(message-queue-push (format nil "⬇ [~a] ~a" ts text)))))))
|
||||
(sleep 0.05)))
|
||||
(error (c)
|
||||
(when *is-running*
|
||||
(log-debug "READER ERROR: ~a" c)
|
||||
(message-queue-push "⬇ [--:--] ERROR: Connection lost.")
|
||||
(setf *is-running* nil))))))
|
||||
:name "passepartout-tui-reader"))
|
||||
#+end_src
|
||||
|
||||
** Main Entry Point (main)
|
||||
|
||||
Top-level entry point with three-pane layout:
|
||||
|
||||
```
|
||||
┌─────────────────────┐
|
||||
│ Status bar (1 row) │
|
||||
├─────────────────────┤
|
||||
│ Chat (h-6) │
|
||||
├─────────────────────┤
|
||||
│ Input (1 row) │
|
||||
└─────────────────────┘
|
||||
```
|
||||
|
||||
Keybindings:
|
||||
- Enter / Return — submit current input
|
||||
- Backspace — delete last character
|
||||
- Up / Down — navigate input history
|
||||
- Page Up / Page Down — scroll chat history
|
||||
- /exit — disconnect and quit
|
||||
- /clear — clear chat history
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun main ()
|
||||
(log-debug "=== START ===")
|
||||
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
|
||||
"Connect to daemon."
|
||||
(handler-case
|
||||
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
|
||||
(error (e) (format t "Offline: ~a~%" e) (return-from main)))
|
||||
(setf *stream* (usocket:socket-stream *socket*))
|
||||
(let ((s (usocket:socket-connect host port :element-type '(unsigned-byte 8))))
|
||||
(setf *stream* (usocket:socket-stream s))
|
||||
(setf *message-queue* nil)
|
||||
(bt:make-thread (lambda () (reader-thread *stream*)) :name "tui-reader")
|
||||
(push (cons :system "* Connected *") *chat-history*)
|
||||
(log-message "Connected to ~a:~a" host port)
|
||||
t)
|
||||
(error (c)
|
||||
(push (cons :system (format nil "* Connection failed: ~a *" c)) *chat-history*)
|
||||
nil)))
|
||||
|
||||
(unwind-protect
|
||||
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t)
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
(status-h 3)
|
||||
(input-h 1)
|
||||
(chat-h (- h status-h input-h 1))
|
||||
(status-win (make-instance 'window :height status-h :width (- w 2) :y 0 :x 1))
|
||||
(chat-win (make-instance 'window :height chat-h :width (- w 2) :y status-h :x 1))
|
||||
(input-win (make-instance 'window :height input-h :width (- w 2) :y (- h input-h 1) :x 1)))
|
||||
(setf (input-blocking input-win) nil)
|
||||
(setf (function-keys-enabled-p input-win) t)
|
||||
(setf (function-keys-enabled-p chat-win) t)
|
||||
(reader-start *stream*)
|
||||
(loop :while *is-running* :do
|
||||
(let ((msgs (message-queue-drain)))
|
||||
(when msgs
|
||||
(dolist (m msgs) (push m *chat-history*))
|
||||
(when (> *chat-scroll-pos* 0)
|
||||
(incf *chat-scroll-pos* (length msgs)))
|
||||
(chat-render chat-win chat-h *chat-scroll-pos*)
|
||||
(status-render status-win)))
|
||||
(let ((ch (get-char input-win)))
|
||||
(when (and ch (not (equal ch -1)))
|
||||
(log-debug "KEY: ~s" ch)
|
||||
(cond
|
||||
;; Enter / Return — submit
|
||||
((or (eql ch 10) (eql ch 13) (eq ch :enter)
|
||||
(eql ch #\Newline) (eql ch #\Return))
|
||||
(setf *chat-scroll-pos* 0)
|
||||
(input-submit *stream*)
|
||||
(chat-render chat-win chat-h 0)
|
||||
(status-render status-win))
|
||||
;; Backspace
|
||||
((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
|
||||
(input-backspace)
|
||||
(input-render input-win))
|
||||
;; Up arrow — history back
|
||||
((or (eq ch :up) (eql ch 259))
|
||||
(let ((prev (input-history-nav :up)))
|
||||
(when prev
|
||||
(setf *input-buffer* (reverse (coerce prev 'list)))
|
||||
(input-render input-win))))
|
||||
;; Down arrow — history forward
|
||||
((or (eq ch :down) (eql ch 258))
|
||||
(let ((next (input-history-nav :down)))
|
||||
(if next
|
||||
(setf *input-buffer* (reverse (coerce next 'list)))
|
||||
(setf *input-buffer* nil))
|
||||
(input-render input-win)))
|
||||
;; Page Up — scroll chat back
|
||||
((or (eq ch :ppage) (eql ch 339))
|
||||
(let* ((hist-len (length *chat-history*))
|
||||
(view-h (- chat-h 2))
|
||||
(max-offset (max 0 (- hist-len view-h))))
|
||||
(setf *chat-scroll-pos*
|
||||
(min (+ *chat-scroll-pos* view-h) max-offset))
|
||||
(chat-render chat-win chat-h *chat-scroll-pos*)
|
||||
(status-render status-win)))
|
||||
;; Page Down — scroll chat forward
|
||||
((or (eq ch :npage) (eql ch 338))
|
||||
(setf *chat-scroll-pos* (max 0 (- *chat-scroll-pos* (- chat-h 2))))
|
||||
(chat-render chat-win chat-h *chat-scroll-pos*)
|
||||
(status-render status-win))
|
||||
;; Printable character
|
||||
((characterp ch)
|
||||
(push ch *input-buffer*)
|
||||
(input-render input-win))
|
||||
;; Integer key code → character
|
||||
((integerp ch)
|
||||
(let ((converted (code-char ch)))
|
||||
(when (graphic-char-p converted)
|
||||
(push converted *input-buffer*)
|
||||
(input-render input-win))))))
|
||||
;; Re-render input on every tick (no key = buffer unchanged)
|
||||
(input-render input-win))
|
||||
(sleep 0.01))))
|
||||
(setf *is-running* nil)
|
||||
(when *socket* (ignore-errors (usocket:socket-close *socket*)))))
|
||||
(defun disconnect-daemon ()
|
||||
"Disconnect from daemon."
|
||||
(when *stream*
|
||||
(ignore-errors (close *stream*))
|
||||
(setf *stream* nil)
|
||||
(push (cons :system "* Disconnected *") *chat-history*)))
|
||||
#+end_src
|
||||
|
||||
** REPL test script (tmux)
|
||||
|
||||
#+begin_src bash :tangle no
|
||||
#!/bin/bash
|
||||
SESSION="oct-tui-test"
|
||||
tmux new-session -d -s "$SESSION" \
|
||||
-e OC_CONFIG_DIR="$HOME/.config/passepartout" \
|
||||
-e PASSEPARTOUT_DATA_DIR="$HOME/.local/share/passepartout" \
|
||||
-e TERM="screen-256color" \
|
||||
"sbcl --non-interactive \
|
||||
--eval '(load (merge-pathnames \"quicklisp/setup.lisp\" (user-homedir-pathname)))' \
|
||||
--eval '(push (truename \"$HOME/.local/share/passepartout/\") asdf:*central-registry*)' \
|
||||
--eval '(ql:quickload :passepartout/tui)' \
|
||||
--eval '(passepartout.gateway-tui:main)'"
|
||||
sleep 5
|
||||
tmux capture-pane -t "$SESSION" -p -S -20
|
||||
tmux send-keys -t "$SESSION" 'hello' Enter
|
||||
sleep 8
|
||||
tmux capture-pane -t "$SESSION" -p -S -20
|
||||
tmux send-keys -t "$SESSION" '/exit' Enter
|
||||
sleep 1
|
||||
tmux kill-session -t "$SESSION" 2>/dev/null || true
|
||||
** Main event loop
|
||||
#+begin_src lisp
|
||||
(defun tui-main ()
|
||||
"Entry point for the TUI client."
|
||||
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
(input-h 1)
|
||||
(config-h 0)
|
||||
(chat-h (- h input-h config-h 3))
|
||||
(status-win (make-instance 'window :height 3 :width (- w 2) :y 0 :x 1))
|
||||
(chat-win (make-instance 'window :height chat-h :width (- w 2) :y 3 :x 1))
|
||||
(config-win (make-instance 'window :height 0 :width (- w 2) :y (- h input-h config-h 1) :x 1))
|
||||
(input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 1) :x 1)))
|
||||
(setf *is-running* t *tui-mode* :chat *input-buffer* nil)
|
||||
(connect-daemon)
|
||||
(setf *chat-scroll-pos* 0)
|
||||
(status-render status-win)
|
||||
(chat-render chat-win chat-h)
|
||||
(input-render input-win)
|
||||
(loop :while *is-running* :do
|
||||
;; drain message queue
|
||||
(dolist (msg (message-queue-drain))
|
||||
(push (cons :received (let ((p (proto-get msg :payload)))
|
||||
(or (proto-get p :text) (format nil "~a" msg))))
|
||||
*chat-history*))
|
||||
;; handle input
|
||||
(let ((ch (get-char input-win)))
|
||||
(when (and ch (not (equal ch -1)))
|
||||
(cond
|
||||
;; F2: toggle config panel
|
||||
((or (eq ch :f2) (and (integerp ch) (= ch 265)))
|
||||
(if (eq *tui-mode* :chat)
|
||||
(progn
|
||||
(setf *tui-mode* :config)
|
||||
(setf *config-panel-height* 10)
|
||||
(setf config-h *config-panel-height*)
|
||||
(setf chat-h (- h input-h config-h 3))
|
||||
(resize chat-win chat-h (- w 2))
|
||||
(resize config-win config-h (- w 2))
|
||||
(config-render config-win))
|
||||
(progn
|
||||
(setf *tui-mode* :chat)
|
||||
(setf config-h 0)
|
||||
(setf chat-h (- h input-h 3))
|
||||
(resize chat-win chat-h (- w 2))
|
||||
(resize config-win 0 (- w 2))
|
||||
(chat-render chat-win chat-h)))
|
||||
(status-render status-win))
|
||||
;; Config mode key handling
|
||||
((eq *tui-mode* :config)
|
||||
(cond
|
||||
((or (eql ch #\q) (eql ch #\Q))
|
||||
(setf *tui-mode* :chat config-h 0 chat-h (- h input-h 3))
|
||||
(resize chat-win chat-h (- w 2))
|
||||
(resize config-win 0 (- w 2))
|
||||
(chat-render chat-win chat-h)
|
||||
(status-render status-win))
|
||||
((eql ch #\1)
|
||||
(config-render config-win)
|
||||
(add-string config-win 3 1 "Providers: check daemon log for status.")
|
||||
(refresh config-win))
|
||||
((eql ch #\2)
|
||||
(config-render config-win)
|
||||
(add-string config-win 3 1 (format nil "Cascade: ~a" *provider-cascade*))
|
||||
(refresh config-win))
|
||||
((eql ch #\3)
|
||||
(config-render config-win)
|
||||
(add-string config-win 3 1 "Models: see recommendations per slot.")
|
||||
(refresh config-win))
|
||||
((eql ch #\4)
|
||||
(config-render config-win)
|
||||
(add-string config-win 3 1 (format nil "Active providers: ~a"
|
||||
(loop for k being the hash-keys of *probabilistic-backends* collect k)))
|
||||
(refresh config-win))))
|
||||
(status-render status-win))
|
||||
;; Chat mode key handling
|
||||
(t
|
||||
(cond
|
||||
;; Enter/Return submit
|
||||
((or (eql ch 10) (eql ch 13) (eq ch :enter) (eql ch #\Newline) (eql ch #\Return))
|
||||
(setf *chat-scroll-pos* 0)
|
||||
(input-submit *stream*)
|
||||
(chat-render chat-win chat-h)
|
||||
(input-render input-win)
|
||||
(status-render status-win))
|
||||
;; Backspace
|
||||
((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
|
||||
(input-backspace)
|
||||
(input-render input-win))
|
||||
;; Up arrow
|
||||
((or (eq ch :up) (eql ch 259))
|
||||
(let ((prev (input-history-nav :up)))
|
||||
(when prev
|
||||
(setf *input-buffer* (reverse (coerce prev 'list)))
|
||||
(input-render input-win))))
|
||||
;; Down arrow
|
||||
((or (eq ch :down) (eql ch 258))
|
||||
(let ((next (input-history-nav :down)))
|
||||
(if next
|
||||
(setf *input-buffer* (reverse (coerce next 'list)))
|
||||
(setf *input-buffer* nil))
|
||||
(input-render input-win)))
|
||||
;; Page Up
|
||||
((or (eq ch :ppage) (eql ch 339))
|
||||
(setf *chat-scroll-pos* (+ *chat-scroll-pos* 10))
|
||||
(chat-render chat-win chat-h)
|
||||
(status-render status-win))
|
||||
;; Page Down
|
||||
((or (eq ch :npage) (eql ch 338))
|
||||
(setf *chat-scroll-pos* (max 0 (- *chat-scroll-pos* 10)))
|
||||
(chat-render chat-win chat-h)
|
||||
(status-render status-win))
|
||||
;; Printable character
|
||||
((characterp ch)
|
||||
(push ch *input-buffer*)
|
||||
(input-render input-win))
|
||||
;; Integer key code
|
||||
((integerp ch)
|
||||
(let ((converted (code-char ch)))
|
||||
(when (and converted (graphic-char-p converted))
|
||||
(push converted *input-buffer*)
|
||||
(input-render input-win))))))))
|
||||
(refresh scr)
|
||||
(sleep 0.01))
|
||||
(disconnect-daemon))))
|
||||
#+end_src
|
||||
|
||||
@@ -89,7 +89,17 @@ Recommended models are curated per task slot — code generation needs different
|
||||
(:background
|
||||
'((:id "meta-llama/llama-3.2-3b-instruct:free" :name "Llama 3.2 3B" :context 131072 :free t :note "Small, fast, efficient")
|
||||
(:id "liquid/lfm-2.5-1.2b-instruct:free" :name "LFM 2.5 1.2B" :context 32768 :free t :note "Ultra-compact, edge-ready")))
|
||||
(t '((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Safe fallback")))))
|
||||
(t '((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Safe fallback")))))
|
||||
#+end_src
|
||||
|
||||
** Slot descriptions (for TUI config display)
|
||||
;; REPL-verified: 2026-05-04
|
||||
#+begin_src lisp
|
||||
(defvar *slot-descriptions*
|
||||
'((:code . "Code generation, refactoring, debugging. Needs strong reasoning and large context.\nRecommend: Qwen3 Coder (free, 35B active) or Laguna M.1 (coding agent).")
|
||||
(:chat . "Casual conversation, Q&A, creative writing. Prefer balanced quality, low latency.\nRecommend: Llama 3.3 70B (strong generalist) or Gemma 4 31B (thinking mode).")
|
||||
(:plan . "Strategic planning, architecture design, complex multi-step reasoning.\nRecommend: Owl Alpha (free, tool use, 1M ctx) or Hermes 3 405B (strongest free reasoning).")
|
||||
(:background . "Heartbeat summaries, delegation responses, tool output filtering. Must be small + fast.\nRecommend: Llama 3.2 3B (131K ctx, fast) or LFM 2.5 1.2B (edge-ready).")))
|
||||
#+end_src
|
||||
|
||||
* Tests
|
||||
|
||||
@@ -116,6 +116,33 @@ Providers register themselves at boot. No API key? That provider doesn't registe
|
||||
*provider-configs*))))))
|
||||
#+end_src
|
||||
|
||||
** Provider connection test (for TUI config)
|
||||
;; REPL-verified: 2026-05-04
|
||||
#+begin_src lisp
|
||||
(defun test-provider-connection (provider &optional api-key)
|
||||
"Test a provider API key by hitting its models endpoint.
|
||||
Returns (:ok) on success, (:fail reason) on failure.
|
||||
If API-KEY is nil, reads from environment."
|
||||
(let* ((config (provider-config provider))
|
||||
(base-url (getf config :base-url))
|
||||
(key-env (getf config :key-env))
|
||||
(url-env (getf config :url-env))
|
||||
(key (or api-key (when key-env (uiop:getenv key-env)))))
|
||||
(handler-case
|
||||
(let ((url (if url-env
|
||||
(let ((host (or (uiop:getenv url-env) "")))
|
||||
(format nil "http://~a/api/tags" host))
|
||||
(format nil "~a/models" (or base-url "")))))
|
||||
(if key-env
|
||||
(progn (dex:get url :headers `(("Authorization" . ,(format nil "Bearer ~a" key)))
|
||||
:connect-timeout 5 :read-timeout 10)
|
||||
'(:ok))
|
||||
(if url-env
|
||||
(progn (dex:get url :connect-timeout 5 :read-timeout 10) '(:ok))
|
||||
'(:fail "No URL source for this provider"))))
|
||||
(error (c) `(:fail ,(format nil "~a" c))))))
|
||||
#+end_src
|
||||
|
||||
** Boot registration
|
||||
#+begin_src lisp
|
||||
(provider-register-all)
|
||||
|
||||
Reference in New Issue
Block a user