Add streaming, batch tool, multi-edit/patch tools; remove leaked API keys
ober
1d01539ff2887bf12ae9d23745a4b1a24dd03e78
--- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ *.wpo /jcode .jerbuild-hashes +jcode.json --- a/lib/jcode/core/agent.sls +++ b/lib/jcode/core/agent.sls @@ -3,7 +3,7 @@ ;;; Source: src/jcode/core/agent.ss (library (jcode core agent) - (export agent-run agent-chat agent-step + (export agent-run agent-chat agent-step current-stream-cb current-provider-override current-model-override) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- @@ -18,6 +18,7 @@ (def current-model-override (make-parameter #f)) (def (system-prompt) "You are an expert AI coding assistant. You help users with software development tasks.\n\nYou have access to tools that let you:\n- Read and write files\n- Execute shell commands\n- Search code and files\n\nWhen the user asks you to do something:\n1. Think about what tools you need\n2. Use tools to gather information or make changes\n3. Report back with results\n\nBe concise and helpful. When editing files, make minimal changes.") + (def current-stream-cb (make-parameter #f)) (def (agent-run session-id user-input) (log-info logger "agent-run" `((session . ,session-id))) (let ([existing (session-get-messages session-id)]) @@ -28,7 +29,11 @@ (session-add-message session-id (make-user-message user-input)) - (agent-loop session-id (session-get-messages session-id))) + (if (current-stream-cb) + (agent-loop-stream + session-id + (session-get-messages session-id)) + (agent-loop session-id (session-get-messages session-id)))) (def (agent-loop session-id messages) (let* ([provider (get-current-provider)] [tools (get-tool-schemas)] @@ -46,6 +51,28 @@ results) (agent-loop session-id (session-get-messages session-id))) response))) + (def (agent-loop-stream session-id messages) + (let* ([provider (get-current-provider)] + [tools (get-tool-schemas)]) + (let-values ([(content tool-calls) + (provider-stream-chat + provider + messages + tools + (current-stream-cb))]) + (let ([response (make-assistant-message + (if (string=? content "") #f content) + (if (null? tool-calls) #f tool-calls))]) + (session-add-message session-id response) + (if (null? tool-calls) + response + (let ([results (execute-tool-calls tool-calls)]) + (for-each + (lambda (r) (session-add-message session-id r)) + results) + (agent-loop-stream + session-id + (session-get-messages session-id)))))))) (def (execute-tool-calls tool-calls) (log-info logger @@ -73,7 +100,9 @@ [messages (list (make-system-message (system-prompt)) (make-user-message user-input))]) - (agent-chat-loop provider messages tools))) + (if (current-stream-cb) + (agent-chat-loop-stream provider messages tools) + (agent-chat-loop provider messages tools)))) (def (agent-chat-loop provider messages tools) (let ([response (provider-chat provider messages tools)]) (if (message-tool-calls response) @@ -85,6 +114,21 @@ results)]) (agent-chat-loop provider new-messages tools)) (message-content response)))) + (def (agent-chat-loop-stream provider messages tools) + (let-values ([(content tool-calls) + (provider-stream-chat + provider + messages + tools + (current-stream-cb))]) + (if (null? tool-calls) + content + (let* ([response (make-assistant-message + (if (string=? content "") #f content) + tool-calls)] + [results (execute-tool-calls tool-calls)] + [new-msgs (append messages (list response) results)]) + (agent-chat-loop-stream provider new-msgs tools))))) (def (agent-step messages) (let* ([provider (get-current-provider)] [tools (get-tool-schemas)]) --- a/lib/jcode/core/config.sls +++ b/lib/jcode/core/config.sls @@ -38,6 +38,7 @@ (def (merge-env-config config) (let ([providers (or (hash-get config "providers") (make-hash-table))]) + (merge-opencode-keys! providers) (for-each (lambda (pair) (let ([key (getenv (car pair))]) @@ -49,9 +50,38 @@ '(("OPENAI_API_KEY" . "openai") ("ANTHROPIC_API_KEY" . "anthropic") ("GOOGLE_API_KEY" . "google") - ("OPENROUTER_API_KEY" . "openrouter"))) + ("OPENROUTER_API_KEY" . "openrouter") + ("DEEPSEEK_API_KEY" . "deepseek"))) (hash-put! config "providers" providers) config)) + (def (merge-opencode-keys! providers) + (let ([auth-file (path-join + (or (getenv "XDG_DATA_HOME") + (path-join (getenv "HOME") ".local" "share")) + "opencode" + "auth.json")]) + (when (file-exists? auth-file) + (try (let ([auth (call-with-input-file + auth-file + read-json)]) + (for-each + (lambda (name) + (let ([entry (hash-get auth name)]) + (when (and entry (hash-get entry "key")) + (let ([p (or (hash-get providers name) + (make-hash-table))]) + (unless (hash-get p "api_key") + (hash-put! + p + "api_key" + (hash-ref entry "key")) + (hash-put! providers name p)))))) + '("openrouter" + "deepseek" + "google" + "openai" + "anthropic"))) + (catch (e) (void)))))) (def (config-ref . keys) (let loop ([obj (*config*)] [keys keys]) (cond --- a/lib/jcode/provider/provider.sls +++ b/lib/jcode/provider/provider.sls @@ -4,13 +4,14 @@ (library (jcode provider provider) (export make-provider provider-chat provider-stream - provider-name provider-model) + provider-stream-chat provider-name provider-model) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name) - (std text json) (std net request) (jcode core log) - (jcode core message) (jerboa core) (jerboa runtime)) + (std text json) (std net request) (std misc string) + (jcode core log) (jcode core message) (jerboa core) + (jerboa runtime)) (def logger (make-logger "provider")) (defstruct provider-record (name api-key model base-url)) (def (provider? x) (provider-record? x)) @@ -335,4 +336,206 @@ (restore-tool-call name name args)))) fn-calls))))) (def (ollama-chat provider messages tools) - (openai-chat provider messages tools))) + (openai-chat provider messages tools)) + (def (openai-stream-body provider messages tools) + (let ([body (make-hash-table)]) + (hash-put! body "model" (provider-model provider)) + (hash-put! body "stream" #t) + (hash-put! body "messages" (map message->json messages)) + (when (and tools (not (null? tools))) + (hash-put! body "tools" tools)) + body)) + (def (openai-stream-chat provider messages tools token-cb) + (let* ([url (string-append + (provider-base-url provider) + "/chat/completions")] + [headers (openai-headers provider)] + [body (openai-stream-body provider messages tools)] + [text-acc (open-output-string)] + [tc-table (make-hash-table)]) + (http-post-stream url headers (json-object->string body) + (lambda (event-str) + (when event-str + (let* ([data (if (string-prefix? "data: " event-str) + (substring + event-str + 6 + (string-length event-str)) + event-str)]) + (cond + [(equal? data "[DONE]") (void)] + [else + (let ([json (guard (e [list #t #f]) + (string->json-object data))]) + (when json + (let* ([choices (hash-get json "choices")] + [choice (and (pair? choices) (car choices))] + [delta (and choice + (hash-get choice "delta"))]) + (when delta + (let ([content (hash-get delta "content")]) + (when (and content + (not (eq? content (void)))) + (put-string text-acc content) + (token-cb content))) + (let ([tcs (hash-get delta "tool_calls")]) + (when (and tcs (list? tcs)) + (for-each + (lambda (tc) + (let* ([idx (or (hash-get tc "index") + 0)] + [acc (or (hash-get tc-table idx) + (let ([a (make-hash-table)]) + (hash-put! + tc-table + idx + a) + a))] + [id (hash-get tc "id")] + [fn (hash-get tc "function")]) + (when id (hash-put! acc "id" id)) + (when fn + (let ([name (hash-get fn "name")] + [args (hash-get + fn + "arguments")]) + (when name + (hash-put! acc "name" name)) + (when args + (hash-put! + acc + "args" + (string-append + (or (hash-get acc "args") + "") + args))))))) + tcs)))))))])))) + (let* ([content (get-output-string text-acc)] + [indices (sort < (hash-keys tc-table))] + [tool-calls (map (lambda (idx) + (let ([acc (hash-ref tc-table idx)]) + (restore-tool-call + (or (hash-get acc "id") + (format "call_~a" idx)) + (or (hash-get acc "name") + "unknown") + (or (hash-get acc "args") "{}")))) + indices)]) + (values content tool-calls))))) + (def (anthropic-stream-headers provider) + `(("Content-Type" . "application/json") + ("x-api-key" . ,(provider-api-key provider)) + ("anthropic-version" . "2023-06-01"))) + (def (anthropic-stream-body provider messages tools) + (let ([body (anthropic-body provider messages tools)]) + (hash-put! body "stream" #t) + body)) + (def (anthropic-stream-chat + provider + messages + tools + token-cb) + (let* ([url (string-append + (provider-base-url provider) + "/messages")] + [headers (anthropic-stream-headers provider)] + [body (anthropic-stream-body provider messages tools)] + [text-acc (open-output-string)] + [tu-table (make-hash-table)] + [current-idx (make-parameter #f)]) + (http-post-stream + url + headers + (json-object->string body) + (lambda (event-str) + (when event-str + (let* ([lines (string-split event-str #\newline)] + [event-type #f] + [data-str #f]) + (for-each + (lambda (line) + (cond + [(string-prefix? "event: " line) + (set! event-type + (substring line 7 (string-length line)))] + [(string-prefix? "data: " line) + (set! data-str + (substring line 6 (string-length line)))])) + lines) + (when (and event-type data-str) + (let ([json (guard (e [list #t #f]) + (string->json-object data-str))]) + (when json + (cond + [(equal? event-type "content_block_delta") + (let ([delta (hash-get json "delta")]) + (when delta + (let ([dtype (hash-get delta "type")]) + (cond + [(equal? dtype "text_delta") + (let ([text (hash-get delta "text")]) + (when text + (put-string text-acc text) + (token-cb text)))] + [(equal? dtype "input_json_delta") + (let ([idx (current-idx)] + [partial (hash-get + delta + "partial_json")]) + (when (and idx partial) + (let ([acc (hash-ref + tu-table + idx + #f)]) + (when acc + (hash-put! + acc + "args" + (string-append + (or (hash-get acc "args") + "") + partial))))))])))) + ((equal? event-type "content_block_start") + (let ([block (hash-get json "content_block")]) + (when (and block + (equal? + (hash-get block "type") + "tool_use")) + (let ([idx (hash-get json "index")]) + (current-idx idx) + (let ([acc (make-hash-table)]) + (hash-put! + acc + "id" + (hash-get block "id")) + (hash-put! + acc + "name" + (hash-get block "name")) + (hash-put! tu-table idx acc)))))) + ((equal? event-type "content_block_stop") + (current-idx #f)) + (#t (void))])))))))) + (let* ([content (get-output-string text-acc)] + [indices (sort < (hash-keys tu-table))] + [tool-calls (map (lambda (idx) + (let ([acc (hash-ref tu-table idx)]) + (restore-tool-call + (or (hash-get acc "id") + (format "tu_~a" idx)) + (or (hash-get acc "name") "unknown") + (or (hash-get acc "args") "{}")))) + indices)]) + (values content tool-calls)))) + (def (provider-stream-chat provider messages tools token-cb) + (case (string->symbol (provider-name provider)) + [(openai openrouter deepseek ollama) + (openai-stream-chat provider messages tools token-cb)] + [(anthropic) + (anthropic-stream-chat provider messages tools token-cb)] + [else + (let* ([response (provider-chat provider messages tools)] + [content (or (message-content response) "")] + [tcs (or (message-tool-calls response) '())]) + (when (> (string-length content) 0) (token-cb content)) + (values content tcs))]))) new file mode 100644 --- /dev/null +++ b/lib/jcode/tool/batch.sls @@ -0,0 +1,86 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/tool/batch.ss + +(library (jcode tool batch) + (export init-batch-tool) + (import + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name) + (std text json) (std misc string) (jcode core log) + (jcode tool registry) (jerboa core) (jerboa runtime)) + (def logger (make-logger "tool.batch")) + (def (init-batch-tool) + (register-tool! + "batch" + "Execute multiple tool calls in sequence. Use this instead of making separate requests for independent operations (reading multiple files, running multiple commands, etc.). Returns labeled results for each call." + (make-batch-schema) + handle-batch)) + (def (handle-batch args) + (let ([calls (hash-ref args "calls" '())]) + (log-debug logger "batch" `((count . ,(length calls)))) + (cond + [(null? calls) "No tool calls provided"] + [(not (list? calls)) + "Error: 'calls' must be an array of tool call objects"] + [else + (let ([results (map (lambda (call) + (let ([tool-name (and (hash-table? call) + (hash-get + call + "tool"))] + [tool-args (and (hash-table? call) + (or (hash-get + call + "args") + (make-hash-table)))]) + (if tool-name + (cons + tool-name + (tool-execute + tool-name + tool-args)) + (cons + "?" + "Error: missing 'tool' field")))) + calls)]) + (string-join + (map (lambda (r) + (format + "<result tool=\"~a\">\n~a\n</result>" + (car r) + (cdr r))) + results) + "\n"))]))) + (def (make-batch-schema) + (let ([schema (make-hash-table)] + [properties (make-hash-table)]) + (hash-put! schema "type" "object") + (let ([calls-prop (make-hash-table)] + [items-sch (make-hash-table)] + [item-props (make-hash-table)] + [tool-prop (make-hash-table)] + [args-prop (make-hash-table)]) + (hash-put! tool-prop "type" "string") + (hash-put! tool-prop "description" "Tool name to call") + (hash-put! args-prop "type" "object") + (hash-put! + args-prop + "description" + "Arguments for the tool call") + (hash-put! item-props "tool" tool-prop) + (hash-put! item-props "args" args-prop) + (hash-put! items-sch "type" "object") + (hash-put! items-sch "properties" item-props) + (hash-put! items-sch "required" '("tool")) + (hash-put! calls-prop "type" "array") + (hash-put! + calls-prop + "description" + "Array of tool calls to execute in sequence") + (hash-put! calls-prop "items" items-sch) + (hash-put! properties "calls" calls-prop)) + (hash-put! schema "properties" properties) + (hash-put! schema "required" '("calls")) + schema))) --- a/lib/jcode/tool/file.sls +++ b/lib/jcode/tool/file.sls @@ -80,7 +80,22 @@ "string" "Glob pattern to filter files (e.g., *.ss)" #f))) - handle-grep)) + handle-grep) + (register-tool! + "multi-edit" + "Apply multiple find-and-replace edits to a file in sequence. More efficient than calling edit repeatedly." + (make-multi-edit-schema) + handle-multi-edit) + (register-tool! + "patch" + "Apply a unified diff patch string to a file. Supports standard --- / +++ / @@ format." + (make-schema + '(("patch" "string" "Unified diff string to apply" #t) + ("path" + "string" + "Target file path (required if not derivable from the diff)" + #f))) + handle-patch)) (def (handle-ls args) (let* ([path (let ([p (hash-ref args "path" #f)]) (if (or (not p) (eq? p (void))) "." p))] @@ -256,6 +271,186 @@ (if (null? results) "No matches found" (string-join (reverse results) "\n"))))) + (def (handle-multi-edit args) + (let ([path (hash-ref args "path" #f)] + [edits (hash-ref args "edits" #f)]) + (unless path + (error 'multi-edit "Missing required parameter: path")) + (unless edits + (error 'multi-edit "Missing required parameter: edits")) + (log-debug logger "multi-edit" `((path . ,path))) + (if (not (file-exists? path)) + (format "Error: File not found: ~a" path) + (let loop ([content (read-file-string path)] + [remaining (if (list? edits) edits (list edits))] + [applied 0]) + (if (null? remaining) + (begin + (write-file-string path content) + (format + "Successfully applied ~a edit~a to ~a" + applied + (if (= applied 1) "" "s") + path)) + (let* ([edit (car remaining)] + [old-str (and (hash-table? edit) + (hash-get edit "old_str"))] + [new-str (or (and (hash-table? edit) + (hash-get edit "new_str")) + "")]) + (if (not old-str) + (loop content (cdr remaining) applied) + (let ([new-content (string-replace-first + content + old-str + new-str)]) + (if (equal? content new-content) + (format + "Error: old_str not found in ~a: ~s" + path + old-str) + (loop + new-content + (cdr remaining) + (+ applied 1))))))))))) + (def (make-multi-edit-schema) + (let ([schema (make-hash-table)] + [properties (make-hash-table)] + [path-prop (make-hash-table)] + [edits-prop (make-hash-table)] + [items-sch (make-hash-table)] + [item-props (make-hash-table)] + [old-prop (make-hash-table)] + [new-prop (make-hash-table)]) + (hash-put! path-prop "type" "string") + (hash-put! + path-prop + "description" + "Path to the file to edit") + (hash-put! old-prop "type" "string") + (hash-put! + old-prop + "description" + "Exact string to find and replace") + (hash-put! new-prop "type" "string") + (hash-put! new-prop "description" "Replacement string") + (hash-put! item-props "old_str" old-prop) + (hash-put! item-props "new_str" new-prop) + (hash-put! items-sch "type" "object") + (hash-put! items-sch "properties" item-props) + (hash-put! items-sch "required" '("old_str")) + (hash-put! edits-prop "type" "array") + (hash-put! + edits-prop + "description" + "List of edits to apply in order") + (hash-put! edits-prop "items" items-sch) + (hash-put! properties "path" path-prop) + (hash-put! properties "edits" edits-prop) + (hash-put! schema "type" "object") + (hash-put! schema "properties" properties) + (hash-put! schema "required" '("path" "edits")) + schema)) + (def (handle-patch args) + (let ([patch-str (hash-ref args "patch" #f)] + [path-override (let ([p (hash-ref args "path" #f)]) + (if (eq? p (void)) #f p))]) + (unless patch-str + (error 'patch "Missing required parameter: patch")) + (log-debug logger "patch" `((path . ,path-override))) + (let* ([path (or path-override + (extract-patch-target patch-str))] + [content (if (file-exists? path) + (read-file-string path) + "")] + [result (apply-unified-patch content patch-str)]) + (if (string? result) + (begin + (write-file-string path result) + (format "Successfully applied patch to ~a" path)) + (format "Error applying patch: ~a" (cdr result)))))) + (def (extract-patch-target patch-str) + (let ([lines (string-split patch-str #\newline)]) + (let loop ([lines lines]) + (cond + [(null? lines) + (error 'patch + "Cannot determine target file from patch (no +++ line found)")] + [(string-prefix? "+++ " (car lines)) + (let ([rest (substring + (car lines) + 4 + (string-length (car lines)))]) + (let ([path (if (string-prefix? "b/" rest) + (substring rest 2 (string-length rest)) + rest)]) + (let ([tab-pos (find-substring path "\t")]) + (if tab-pos (substring path 0 tab-pos) path))))] + [else (loop (cdr lines))])))) + (def (apply-unified-patch content patch-str) + (let ([patch-lines (string-split patch-str #\newline)]) + (let loop ([lines patch-lines] [result content]) + (cond + [(null? lines) result] + [(string-prefix? "@@ " (car lines)) + (let-values ([(old-text new-text rest) + (hunk-texts (cdr lines))]) + (let ([patched (apply-hunk result old-text new-text)]) + (if (string? patched) (loop rest patched) patched)))] + [else (loop (cdr lines) result)])))) + (def (hunk-texts lines) + (let loop ([lines lines] [old '()] [new '()]) + (cond + [(null? lines) + (values + (string-join (reverse old) "\n") + (string-join (reverse new) "\n") + '())] + [(string-prefix? "@@ " (car lines)) + (values + (string-join (reverse old) "\n") + (string-join (reverse new) "\n") + lines)] + [else + (let ([line (car lines)]) + (if (= (string-length line) 0) + (loop (cdr lines) old new) + (let ([ch (string-ref line 0)]) + (cond + [(char=? ch #\space) + (let ([text (substring + line + 1 + (string-length line))]) + (loop + (cdr lines) + (cons text old) + (cons text new)))] + [(char=? ch #\-) + (let ([text (substring + line + 1 + (string-length line))]) + (loop (cdr lines) (cons text old) new))] + [(char=? ch #\+) + (let ([text (substring + line + 1 + (string-length line))]) + (loop (cdr lines) old (cons text new)))] + [else (loop (cdr lines) old new)]))))]))) + (def (apply-hunk content old-text new-text) + (if (string=? old-text "") + content + (let ([patched (string-replace-first + content + old-text + new-text)]) + (if (equal? patched content) + (cons + 'error + (format "hunk context not found: ~s" old-text)) + patched)))) (def (strip-trailing-slash s) (let ([n (string-length s)]) (if (and (> n 0) (char=? (string-ref s (- n 1)) #\/)) --- a/lib/jcode/ui/cli.sls +++ b/lib/jcode/ui/cli.sls @@ -11,7 +11,8 @@ (std misc string) (jcode core config) (jcode core log) (jcode core session) (jcode core message) (jcode core agent) (jcode tool registry) (jcode tool file) (jcode tool bash) - (jcode tool web) (jerboa core) (jerboa runtime)) + (jcode tool web) (jcode tool batch) (jerboa core) + (jerboa runtime)) (def logger (make-logger "cli")) (def *version* "0.1.0") (def (cli-main args) @@ -74,10 +75,8 @@ (cddr args) (cons (cons '\x2D;-provider (cadr args)) opts))] [else (cons (cons '\x2D;- args) (reverse opts))]))) - (def (init-tools) - (init-file-tools) - (init-bash-tool) - (init-web-tools)) + (def (init-tools) (init-file-tools) (init-bash-tool) + (init-web-tools) (init-batch-tool)) (def (display-help) (display "jcode - Portable AI coding agent\n\nUSAGE:\n jcode [OPTIONS] [PROMPT]\n jcode [COMMAND]\n\nOPTIONS:\n -h, --help Show this help message\n -v, --version Show version\n -d, --debug Enable debug logging\n -m, --model Model to use (default: claude-sonnet-4-20250514)\n -p, --provider Provider to use (default: anthropic)\n\nCOMMANDS:\n session list List all sessions\n session resume Resume a previous session\n config Show or edit configuration\n\nEXAMPLES:\n jcode Start interactive session\n jcode \"Read main.ss\" One-shot query\n jcode session list List sessions\n")) @@ -115,17 +114,24 @@ (exit 0)] [else (printf "Unknown command: /~a~n" cmd)]))) (def (handle-user-input input session-id) - (try (let ([response (agent-run session-id input)]) - (when (message-content response) - (printf "~n~a~n~n" (message-content response)))) + (try (printf "~n") (flush-output-port (current-output-port)) + (parameterize ([current-stream-cb + (lambda (token) + (display token) + (flush-output-port (current-output-port)))]) + (agent-run session-id input)) + (printf "~n~n") (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) - (printf "Error: ~a~n" (err->string e))))) + (printf "~nError: ~a~n" (err->string e))))) (def (one-shot-mode prompt opts) - (try (let ([response (agent-chat prompt)]) - (display response) - (newline)) + (try (parameterize ([current-stream-cb + (lambda (token) + (display token) + (flush-output-port (current-output-port)))]) + (agent-chat prompt)) + (newline) (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) --- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -3,6 +3,7 @@ (export agent-run agent-chat agent-step + current-stream-cb current-provider-override current-model-override) @@ -34,13 +35,17 @@ When the user asks you to do something: Be concise and helpful. When editing files, make minimal changes.") +(def current-stream-cb (make-parameter #f)) + (def (agent-run session-id user-input) (log-info logger "agent-run" `((session . ,session-id))) (let ((existing (session-get-messages session-id))) (when (null? existing) (session-add-message session-id (make-system-message (system-prompt))))) (session-add-message session-id (make-user-message user-input)) - (agent-loop session-id (session-get-messages session-id))) + (if (current-stream-cb) + (agent-loop-stream session-id (session-get-messages session-id)) + (agent-loop session-id (session-get-messages session-id)))) (def (agent-loop session-id messages) (let* ((provider (get-current-provider)) @@ -56,6 +61,22 @@ Be concise and helpful. When editing files, make minimal changes.") (agent-loop session-id (session-get-messages session-id))) response))) +(def (agent-loop-stream session-id messages) + ;; Streaming version: calls (current-stream-cb) for each text token. + (let* ((provider (get-current-provider)) + (tools (get-tool-schemas))) + (let-values (((content tool-calls) + (provider-stream-chat provider messages tools (current-stream-cb)))) + (let ((response (make-assistant-message + (if (string=? content "") #f content) + (if (null? tool-calls) #f tool-calls)))) + (session-add-message session-id response) + (if (null? tool-calls) + response + (let ((results (execute-tool-calls tool-calls))) + (for-each (lambda (r) (session-add-message session-id r)) results) + (agent-loop-stream session-id (session-get-messages session-id)))))))) + (def (execute-tool-calls tool-calls) (log-info logger "executing-tools" `((count . ,(length tool-calls)))) (map execute-single-tool tool-calls)) @@ -79,7 +100,9 @@ Be concise and helpful. When editing files, make minimal changes.") (messages (list (make-system-message (system-prompt)) (make-user-message user-input)))) - (agent-chat-loop provider messages tools))) + (if (current-stream-cb) + (agent-chat-loop-stream provider messages tools) + (agent-chat-loop provider messages tools)))) (def (agent-chat-loop provider messages tools) (let ((response (provider-chat provider messages tools))) @@ -89,6 +112,18 @@ Be concise and helpful. When editing files, make minimal changes.") (agent-chat-loop provider new-messages tools)) (message-content response)))) +(def (agent-chat-loop-stream provider messages tools) + (let-values (((content tool-calls) + (provider-stream-chat provider messages tools (current-stream-cb)))) + (if (null? tool-calls) + content + (let* ((response (make-assistant-message + (if (string=? content "") #f content) + tool-calls)) + (results (execute-tool-calls tool-calls)) + (new-msgs (append messages (list response) results))) + (agent-chat-loop-stream provider new-msgs tools))))) + (def (agent-step messages) (let* ((provider (get-current-provider)) (tools (get-tool-schemas))) --- a/src/jcode/core/config.ss +++ b/src/jcode/core/config.ss @@ -39,6 +39,9 @@ (def (merge-env-config config) (let ((providers (or (hash-get config "providers") (make-hash-table)))) + ;; Load keys from opencode auth.json if available + (merge-opencode-keys! providers) + ;; Env vars override everything (for-each (lambda (pair) (let ((key (getenv (car pair)))) @@ -49,10 +52,30 @@ '(("OPENAI_API_KEY" . "openai") ("ANTHROPIC_API_KEY" . "anthropic") ("GOOGLE_API_KEY" . "google") - ("OPENROUTER_API_KEY" . "openrouter"))) + ("OPENROUTER_API_KEY" . "openrouter") + ("DEEPSEEK_API_KEY" . "deepseek"))) (hash-put! config "providers" providers) config)) +(def (merge-opencode-keys! providers) + ;; Read ~/.local/share/opencode/auth.json for provider keys + (let ((auth-file (path-join (or (getenv "XDG_DATA_HOME") + (path-join (getenv "HOME") ".local" "share")) + "opencode" "auth.json"))) + (when (file-exists? auth-file) + (try + (let ((auth (call-with-input-file auth-file read-json))) + (for-each + (lambda (name) + (let ((entry (hash-get auth name))) + (when (and entry (hash-get entry "key")) + (let ((p (or (hash-get providers name) (make-hash-table)))) + (unless (hash-get p "api_key") ;; don't override existing + (hash-put! p "api_key" (hash-ref entry "key")) + (hash-put! providers name p)))))) + '("openrouter" "deepseek" "google" "openai" "anthropic"))) + (catch (e) (void)))))) + (def (config-ref . keys) (let loop ((obj (*config*)) (keys keys)) (cond --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -3,11 +3,13 @@ (export make-provider provider-chat provider-stream + provider-stream-chat provider-name provider-model) (import :std/text/json :std/net/request + :std/misc/string :jcode/core/log :jcode/core/message) @@ -298,3 +300,184 @@ (def (ollama-chat provider messages tools) ;; Ollama exposes an OpenAI-compatible /v1/chat/completions endpoint (openai-chat provider messages tools)) + +;;; OpenAI Streaming ;;; + +(def (openai-stream-body provider messages tools) + (let ((body (make-hash-table))) + (hash-put! body "model" (provider-model provider)) + (hash-put! body "stream" #t) + (hash-put! body "messages" (map message->json messages)) + (when (and tools (not (null? tools))) + (hash-put! body "tools" tools)) + body)) + +(def (openai-stream-chat provider messages tools token-cb) + ;; Stream via SSE. Calls token-cb with each text token. + ;; Returns (values content-string tool-call-list) + (let* ((url (string-append (provider-base-url provider) "/chat/completions")) + (headers (openai-headers provider)) + (body (openai-stream-body provider messages tools)) + (text-acc (open-output-string)) + ;; tool-call accumulators: index -> alist with id/name/args-so-far + (tc-table (make-hash-table))) + (http-post-stream url headers (json-object->string body) + (lambda (event-str) + (when event-str + ;; Strip "data: " prefix + (let* ((data (if (string-prefix? "data: " event-str) + (substring event-str 6 (string-length event-str)) + event-str))) + (cond + ((equal? data "[DONE]") (void)) + (else + (let ((json (guard (e [#t #f]) + (string->json-object data)))) + (when json + (let* ((choices (hash-get json "choices")) + (choice (and (pair? choices) (car choices))) + (delta (and choice (hash-get choice "delta")))) + (when delta + ;; Text content token + (let ((content (hash-get delta "content"))) + (when (and content (not (eq? content (void)))) + (put-string text-acc content) + (token-cb content))) + ;; Tool call fragments + (let ((tcs (hash-get delta "tool_calls"))) + (when (and tcs (list? tcs)) + (for-each + (lambda (tc) + (let* ((idx (or (hash-get tc "index") 0)) + (acc (or (hash-get tc-table idx) + (let ((a (make-hash-table))) + (hash-put! tc-table idx a) + a))) + (id (hash-get tc "id")) + (fn (hash-get tc "function"))) + (when id (hash-put! acc "id" id)) + (when fn + (let ((name (hash-get fn "name")) + (args (hash-get fn "arguments"))) + (when name (hash-put! acc "name" name)) + (when args + (hash-put! acc "args" + (string-append + (or (hash-get acc "args") "") + args))))))) + tcs)))))))))))) + ;; Build result + (let* ((content (get-output-string text-acc)) + (indices (sort < (hash-keys tc-table))) + (tool-calls + (map (lambda (idx) + (let ((acc (hash-ref tc-table idx))) + (restore-tool-call + (or (hash-get acc "id") (format "call_~a" idx)) + (or (hash-get acc "name") "unknown") + (or (hash-get acc "args") "{}")))) + indices))) + (values content tool-calls))))) + +;;; Anthropic Streaming ;;; + +(def (anthropic-stream-headers provider) + `(("Content-Type" . "application/json") + ("x-api-key" . ,(provider-api-key provider)) + ("anthropic-version" . "2023-06-01"))) + +(def (anthropic-stream-body provider messages tools) + (let ((body (anthropic-body provider messages tools))) + (hash-put! body "stream" #t) + body)) + +(def (anthropic-stream-chat provider messages tools token-cb) + ;; Anthropic SSE streaming. Returns (values content tool-call-list) + (let* ((url (string-append (provider-base-url provider) "/messages")) + (headers (anthropic-stream-headers provider)) + (body (anthropic-stream-body provider messages tools)) + (text-acc (open-output-string)) + ;; tool use accumulators: id -> alist + (tu-table (make-hash-table)) + (current-idx (make-parameter #f))) + (http-post-stream url headers (json-object->string body) + (lambda (event-str) + (when event-str + ;; Anthropic SSE uses multiple lines per event: "event: ...\ndata: ..." + (let* ((lines (string-split event-str #\newline)) + (event-type #f) + (data-str #f)) + (for-each + (lambda (line) + (cond + ((string-prefix? "event: " line) + (set! event-type (substring line 7 (string-length line)))) + ((string-prefix? "data: " line) + (set! data-str (substring line 6 (string-length line)))))) + lines) + (when (and event-type data-str) + (let ((json (guard (e [#t #f]) (string->json-object data-str)))) + (when json + (cond + ;; Text delta + ((equal? event-type "content_block_delta") + (let ((delta (hash-get json "delta"))) + (when delta + (let ((dtype (hash-get delta "type"))) + (cond