v0.8.0: TUI stabilization, command palette reverse-video highlight, hint bar redesign
- ROADMAP: consolidate all TUI work under v0.8.0 (removed premature v0.9.0/v0.10.x labels), restored original v0.9.0 eval harness plan - channel-tui-view.org: Emacs-style reverse-video cursor (swap fg/bg instead of drawing █), hint bar now shows F:focus/MCP:count on left and token gauge + keybindings on right, sidebar reorganized to show GATE TRACE, RULES + BLOCK COUNT, COST, FILES panels - channel-tui-main.org: command palette selection now uses reverse-video highlight (bg-input fg on input-fg bg, matching cursor style), fixed cond order so sel-p is checked before cat (all items had :category making sel-p unreachable), added session-cost extraction from daemon - passepartout: export COLORTERM=truecolor for modern backend detection
This commit is contained in:
244
lisp/neuro-provider.lisp
Normal file
244
lisp/neuro-provider.lisp
Normal file
@@ -0,0 +1,244 @@
|
||||
(in-package :passepartout)
|
||||
|
||||
(defparameter *provider-configs*
|
||||
'((:local . (:base-url nil :key-env nil :url-env "LOCAL_BASE_URL" :default-model "llama3"))
|
||||
(:openrouter . (:base-url "https://openrouter.ai/api/v1" :key-env "OPENROUTER_API_KEY" :default-model "openrouter/auto"))
|
||||
(:openai . (:base-url "https://api.openai.com/v1" :key-env "OPENAI_API_KEY" :default-model "gpt-4o-mini"))
|
||||
(:anthropic . (:base-url "https://api.anthropic.com/v1" :key-env "ANTHROPIC_API_KEY" :default-model "claude-3-5-sonnet-20241022"))
|
||||
(:groq . (:base-url "https://api.groq.com/openai/v1" :key-env "GROQ_API_KEY" :default-model "llama-3.1-70b-versatile"))
|
||||
(:gemini . (:base-url "https://generativelanguage.googleapis.com/v1beta/openai" :key-env "GEMINI_API_KEY" :default-model "gemini-2.0-flash"))
|
||||
(:deepseek . (:base-url "https://api.deepseek.com/v1" :key-env "DEEPSEEK_API_KEY" :default-model "deepseek-chat"))
|
||||
(:nvidia . (:base-url "https://integrate.api.nvidia.com/v1" :key-env "NVIDIA_API_KEY" :default-model "meta/llama-3.1-405b-instruct"))))
|
||||
|
||||
(defun provider-config (provider)
|
||||
"Returns the configuration plist for a provider keyword."
|
||||
(cdr (assoc provider *provider-configs*)))
|
||||
|
||||
(defun provider-available-p (provider)
|
||||
"Checks if a provider is configured. Checks API key or URL env vars."
|
||||
(let* ((config (provider-config provider))
|
||||
(key-env (getf config :key-env))
|
||||
(url-env (getf config :url-env))
|
||||
(base-url (getf config :base-url)))
|
||||
(cond (key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0))))
|
||||
(url-env (let ((url (uiop:getenv url-env))) (and url (> (length url) 0))))
|
||||
(base-url t))))
|
||||
|
||||
(defun provider-openai-request (prompt system-prompt &key model (provider :openrouter) tools)
|
||||
"Executes a request against any OpenAI-compatible API endpoint.
|
||||
When :tools is provided, includes function-calling tool definitions in the request."
|
||||
(let* ((config (provider-config provider))
|
||||
(base-url (getf config :base-url))
|
||||
(key-env (getf config :key-env))
|
||||
(url-env (getf config :url-env))
|
||||
(default-model (getf config :default-model))
|
||||
(api-key (when key-env (uiop:getenv key-env)))
|
||||
(model-id (or model default-model))
|
||||
(url (if url-env
|
||||
(let ((host (uiop:getenv url-env)))
|
||||
(if host
|
||||
(format nil "http://~a/v1/chat/completions" host)
|
||||
(format nil "~a/chat/completions" base-url)))
|
||||
(format nil "~a/chat/completions" base-url)))
|
||||
(timeout (or (ignore-errors
|
||||
(parse-integer (uiop:getenv "LLM_REQUEST_TIMEOUT")))
|
||||
30))
|
||||
(headers `(("Content-Type" . "application/json")
|
||||
,@(when api-key `(("Authorization" . ,(format nil "Bearer ~a" api-key))))
|
||||
,@(when (eq provider :openrouter)
|
||||
`(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout")
|
||||
("X-Title" . "Passepartout")))))
|
||||
(body (let ((base `((model . ,model-id)
|
||||
(messages . (( (role . "system") (content . ,system-prompt) )
|
||||
( (role . "user") (content . ,prompt) ))))))
|
||||
(if tools
|
||||
(append base
|
||||
`((tools . ,(loop for tool in tools
|
||||
collect (list (cons :|type| "function")
|
||||
(cons :|function| (loop for (k v) on tool by #'cddr
|
||||
collect (cons (intern (string-upcase (string k)) "KEYWORD") v))))))
|
||||
(:|tool_choice| . "auto")))
|
||||
base)))
|
||||
(body-json (cl-json:encode-json-to-string body)))
|
||||
(handler-case
|
||||
(let* ((response (dex:post url :headers headers :content body-json
|
||||
:connect-timeout (min 5 timeout)
|
||||
:read-timeout (max 10 (- timeout 5))))
|
||||
(json (cl-json:decode-json-from-string response))
|
||||
(choices (cdr (assoc :choices json)))
|
||||
(first-choice (car choices))
|
||||
(message (cdr (assoc :message first-choice)))
|
||||
(tool-calls (cdr (assoc :|tool_calls| message)))
|
||||
(content (cdr (assoc :content message))))
|
||||
(cond
|
||||
(tool-calls
|
||||
(list :status :success
|
||||
:tool-calls
|
||||
(loop for tc in tool-calls
|
||||
for fun = (cdr (assoc :|function| tc))
|
||||
for args-str = (cdr (assoc :|arguments| fun))
|
||||
for args = (when args-str (cl-json:decode-json-from-string args-str))
|
||||
collect (list :name (cdr (assoc :|name| fun))
|
||||
:arguments args))))
|
||||
(content
|
||||
(list :status :success :content content))
|
||||
(t
|
||||
(list :status :error :message (format nil "~a: No content" provider)))))
|
||||
(error (c)
|
||||
(list :status :error :message (format nil "~a Failure: ~a" provider c))))))
|
||||
|
||||
(defun provider-register-all ()
|
||||
"Scans environment variables and registers all available LLM backends."
|
||||
(dolist (entry *provider-configs*)
|
||||
(let ((provider (car entry)))
|
||||
(when (provider-available-p provider)
|
||||
(log-message "LLM BACKEND: Registering provider ~a" provider)
|
||||
(register-probabilistic-backend provider
|
||||
(lambda (prompt system-prompt &key model tools)
|
||||
(provider-openai-request prompt system-prompt :model model :provider provider :tools tools)))))))
|
||||
|
||||
(defun provider-cascade-initialize ()
|
||||
"Reads PROVIDER_CASCADE from env and sets *provider-cascade*."
|
||||
(let ((cascade-str (uiop:getenv "PROVIDER_CASCADE")))
|
||||
(if cascade-str
|
||||
(setf *provider-cascade*
|
||||
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space #\" #\') s)) :keyword))
|
||||
(uiop:split-string cascade-str :separator '(#\,))))
|
||||
(setf *provider-cascade* (mapcar #'car (remove-if (lambda (e)
|
||||
(member (car e) '(:local)))
|
||||
*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)
|
||||
|
||||
(defskill :passepartout-neuro-provider
|
||||
:priority 50
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
|
||||
(defun cascade-stream (prompt system-prompt callback)
|
||||
"Streaming cascade: calls provider-openai-stream on the first available backend.
|
||||
Calls CALLBACK with each delta string, then with '' to signal end-of-stream."
|
||||
(dolist (backend *provider-cascade*)
|
||||
(when (gethash backend *probabilistic-backends*)
|
||||
(let ((result (provider-openai-stream prompt system-prompt callback
|
||||
:provider backend)))
|
||||
(when (eq (getf result :status) :success)
|
||||
(return cascade-stream))))))
|
||||
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun parse-sse-line (line)
|
||||
"Parse an SSE line. Returns data string, :done for [DONE], nil otherwise."
|
||||
(cond
|
||||
((or (null line) (string= line "")) nil)
|
||||
((char= (char line 0) #\:) nil)
|
||||
((and (>= (length line) 6) (string-equal (subseq line 0 6) "data: "))
|
||||
(let ((content (subseq line 6)))
|
||||
(if (string= content "[DONE]")
|
||||
:done
|
||||
content)))
|
||||
(t nil)))
|
||||
|
||||
(defvar *stream-cancel* nil
|
||||
"When T, the streaming SSE loop exits early.")
|
||||
|
||||
(defun provider-openai-stream (prompt system-prompt callback &key model (provider :openrouter) tools)
|
||||
"Streaming OpenAI-compatible request. Calls CALLBACK with each delta, then ''."
|
||||
(let* ((config (provider-config provider))
|
||||
(base-url (getf config :base-url))
|
||||
(key-env (getf config :key-env))
|
||||
(url-env (getf config :url-env))
|
||||
(default-model (getf config :default-model))
|
||||
(api-key (when key-env (uiop:getenv key-env)))
|
||||
(model-id (or model default-model))
|
||||
(url (if url-env
|
||||
(let ((host (uiop:getenv url-env)))
|
||||
(if host
|
||||
(format nil "http://~a/v1/chat/completions" host)
|
||||
(format nil "~a/chat/completions" base-url)))
|
||||
(format nil "~a/chat/completions" base-url)))
|
||||
(timeout (or (ignore-errors (parse-integer (uiop:getenv "LLM_REQUEST_TIMEOUT"))) 30))
|
||||
(req-headers (list (cons "Content-Type" "application/json")))
|
||||
(base `((model . ,model-id)
|
||||
(messages . (( (role . "system") (content . ,system-prompt) )
|
||||
( (role . "user") (content . ,prompt) )))
|
||||
(stream . t))))
|
||||
(when api-key
|
||||
(push (cons "Authorization" (format nil "Bearer ~a" api-key)) req-headers))
|
||||
(when (eq provider :openrouter)
|
||||
(setf req-headers
|
||||
(append req-headers
|
||||
`(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout")
|
||||
("X-Title" . "Passepartout")))))
|
||||
(let ((body (if tools
|
||||
(append base
|
||||
`((tools . ,(loop for tool in tools
|
||||
collect (list (cons :|type| "function")
|
||||
(cons :|function|
|
||||
(loop for (k v) on tool by #'cddr
|
||||
collect (cons (intern (string-upcase (string k)) "KEYWORD") v))))))
|
||||
(:|tool_choice| . "auto")))
|
||||
base)))
|
||||
(handler-case
|
||||
(let* ((body-json (cl-json:encode-json-to-string body))
|
||||
(stall-seconds 30)
|
||||
(s (dex:post url :headers req-headers :content body-json
|
||||
:connect-timeout (min 5 timeout)
|
||||
:read-timeout stall-seconds
|
||||
:want-stream t)))
|
||||
;; v0.7.1: track stall timer — reset on each successful chunk
|
||||
(let ((last-chunk-time (get-universal-time)))
|
||||
(loop for raw = (handler-case (read-line s nil nil)
|
||||
(error (c)
|
||||
(declare (ignore c))
|
||||
nil))
|
||||
while raw
|
||||
do (when *stream-cancel* ; v0.7.1: cancel check
|
||||
(setf *stream-cancel* nil)
|
||||
(funcall callback " [cancelled]")
|
||||
(return))
|
||||
(let ((parsed (parse-sse-line raw)))
|
||||
(cond
|
||||
((null parsed))
|
||||
((eq parsed :done) (return))
|
||||
(t (handler-case
|
||||
(let* ((json (cl-json:decode-json-from-string parsed))
|
||||
(choices (cdr (assoc :choices json)))
|
||||
(choice (car choices))
|
||||
(delta (cdr (assoc :delta choice)))
|
||||
(content (cdr (assoc :content delta))))
|
||||
(when content
|
||||
(funcall callback content)
|
||||
(setf last-chunk-time (get-universal-time))))
|
||||
(error ())))))
|
||||
(when (> (- (get-universal-time) last-chunk-time) stall-seconds)
|
||||
(funcall callback "[Response stalled — timed out at 30s]")
|
||||
(return))))
|
||||
(funcall callback "")
|
||||
(close s)
|
||||
(list :status :success))
|
||||
(error (c)
|
||||
(list :status :error :message (format nil "~a Stream Failure: ~a" provider c)))))))
|
||||
Reference in New Issue
Block a user