Add git tools, tool indicators, retry logic, REPL improvements
ober
99c3c4c10d3601b4308e8cb8df26559cba634d68
--- a/lib/jcode/core/agent.sls +++ b/lib/jcode/core/agent.sls @@ -4,7 +4,8 @@ (library (jcode core agent) (export agent-run agent-chat agent-step current-stream-cb - current-provider-override current-model-override) + current-tool-cb current-provider-override + current-model-override) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -17,8 +18,11 @@ (def current-provider-override (make-parameter #f)) (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.") + (format + "You are an expert AI coding assistant. You help users with software development tasks.\nWorking directory: ~a\n\nYou have access to these tools:\n- read, write, edit, multi-edit: Read and modify files\n- glob, grep, ls: Search and list files\n- bash: Execute shell commands\n- fetch: HTTP requests\n- batch: Run multiple tool calls in parallel\n- git_status, git_diff, git_log, git_show, git_commit: Git operations\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 targeted changes.\nPrefer using the edit tool over write for modifying existing files." + (current-directory))) (def current-stream-cb (make-parameter #f)) + (def current-tool-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)]) @@ -82,12 +86,15 @@ (def (execute-single-tool tc) (let* ([name (tool-call-name tc)] [args (string->json-object (tool-call-arguments tc))] - [result (tool-execute name args)]) - (log-debug - logger - "tool-result" - `((tool . ,name) (result-length . ,(string-length result)))) - (make-tool-result (tool-call-id tc) result))) + [cb (current-tool-cb)]) + (when cb (cb 'start name args)) + (let ([result (tool-execute name args)]) + (log-debug + logger + "tool-result" + `((tool . ,name) (result-length . ,(string-length result)))) + (when cb (cb 'end name args)) + (make-tool-result (tool-call-id tc) result)))) (def (get-current-provider) (let* ([provider-name (or (current-provider-override) (config-provider))] --- a/lib/jcode/provider/provider.sls +++ b/lib/jcode/provider/provider.sls @@ -10,9 +10,20 @@ getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name) (std text json) (std net request) (std misc string) - (jcode core log) (jcode core message) (jerboa core) - (jerboa runtime)) + (std misc retry) (jcode core log) (jcode core message) + (jerboa core) (jerboa runtime)) (def logger (make-logger "provider")) + (def *api-retry-policy* (make-retry-policy 3 1.0 30.0 #t)) + (def (retryable-error? e) + (let ([msg (with-output-to-string + (lambda () (display-condition e)))]) + (or (string-contains msg "429") + (string-contains msg "500") + (string-contains msg "502") + (string-contains msg "503") + (string-contains msg "529")))) + (def (api-call-with-retry thunk) + (retry/predicate thunk retryable-error? 3 1.0)) (defstruct provider-record (name api-key model base-url)) (def (provider? x) (provider-record? x)) (def (provider-name p) (provider-record-name p)) @@ -52,16 +63,18 @@ `((provider . ,(provider-name provider)) (model . ,(provider-model provider)) (messages . ,(length messages)))) - (case (string->symbol (provider-name provider)) - [(openai openrouter deepseek) - (openai-chat provider messages tools)] - [(anthropic) (anthropic-chat provider messages tools)] - [(google) (google-chat provider messages tools)] - [(ollama) (ollama-chat provider messages tools)] - [else - (error 'provider-chat - "Unknown provider" - (provider-name provider))])) + (api-call-with-retry + (lambda () + (case (string->symbol (provider-name provider)) + [(openai openrouter deepseek) + (openai-chat provider messages tools)] + [(anthropic) (anthropic-chat provider messages tools)] + [(google) (google-chat provider messages tools)] + [(ollama) (ollama-chat provider messages tools)] + [else + (error 'provider-chat + "Unknown provider" + (provider-name provider))])))) (def (provider-stream provider messages tools callback) (let ([response (provider-chat provider messages tools)]) (callback response) new file mode 100644 --- /dev/null +++ b/lib/jcode/tool/git.sls @@ -0,0 +1,171 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/tool/git.ss + +(library (jcode tool git) + (export init-git-tools) + (import + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name) + (std os shell) (std misc string) (jcode core log) + (jcode tool registry) (jerboa core) (jerboa runtime)) + (def logger (make-logger "tool.git")) + (def (init-git-tools) + (register-tool! + "git_status" + "Show the working tree status. Returns modified, staged, and untracked files." + (make-git-schema + '(("path" + "string" + "Repository path (default: current directory)" + #f))) + handle-git-status) + (register-tool! + "git_diff" + "Show changes in the working tree or between commits." + (make-git-schema + '(("path" + "string" + "Repository path (default: current directory)" + #f) + ("staged" + "boolean" + "Show staged changes only (default: false)" + #f) + ("ref" + "string" + "Compare against a specific ref (branch, tag, commit)" + #f) + ("file" "string" "Limit diff to a specific file" #f))) + handle-git-diff) + (register-tool! + "git_log" + "Show recent commit history." + (make-git-schema + '(("path" + "string" + "Repository path (default: current directory)" + #f) + ("count" + "number" + "Number of commits to show (default: 10)" + #f) + ("oneline" + "boolean" + "Show compact one-line format (default: true)" + #f) + ("file" "string" "Show history for a specific file" #f))) + handle-git-log) + (register-tool! + "git_show" + "Show the contents of a specific commit." + (make-git-schema + '(("ref" "string" "Commit hash, branch, or tag to show" #t) + ("path" + "string" + "Repository path (default: current directory)" + #f))) + handle-git-show) + (register-tool! + "git_commit" + "Create a git commit with the given message. Only commits already-staged files unless paths are specified." + (make-git-schema + '(("message" "string" "Commit message" #t) + ("paths" + "string" + "Space-separated paths to stage before committing" + #f) + ("path" + "string" + "Repository path (default: current directory)" + #f))) + handle-git-commit)) + (def (make-git-schema params) + (let ([schema (make-hash-table)] + [properties (make-hash-table)] + [required '()]) + (hash-put! schema "type" "object") + (for-each + (lambda (param) + (let ([name (car param)] + [type (cadr param)] + [desc (caddr param)] + [req? (cadddr param)] + [prop (make-hash-table)]) + (hash-put! prop "type" type) + (hash-put! prop "description" desc) + (hash-put! properties name prop) + (when req? (set! required (cons name required))))) + params) + (hash-put! schema "properties" properties) + (hash-put! schema "required" (reverse required)) + schema)) + (def (run-git args . opts) + (let ([cwd (if (pair? opts) (car opts) #f)]) + (try (let-values ([(stdout stderr exit-code) + (shell/status (git-cmd args) cwd)]) + (if (= exit-code 0) + (string-trim stdout) + (format + "git error (exit ~a): ~a" + exit-code + (string-trim + (if (string=? stderr "") stdout stderr))))) + (catch (e) (format "Error: ~a" (err->string e)))))) + (def (git-cmd args) (string-join (cons "git" args) " ")) + (def (handle-git-status args) + (let ([cwd (hash-get args "path")]) + (log-info logger "git-status" (if cwd `((path . ,cwd)) '())) + (run-git '("status" "--short" "--branch") cwd))) + (def (handle-git-diff args) + (let ([cwd (hash-get args "path")] + [staged (hash-get args "staged")] + [ref (hash-get args "ref")] + [file (hash-get args "file")]) + (log-info + logger + "git-diff" + `((staged . ,staged) (ref . ,ref))) + (let ([cmd (append + '("diff") + (if staged '("--cached") '()) + (if ref (list ref) '()) + (if file (list "--" file) '()))]) + (run-git cmd cwd)))) + (def (handle-git-log args) + (let ([cwd (hash-get args "path")] + [count (hash-get args "count")] + [oneline (hash-get args "oneline")] + [file (hash-get args "file")]) + (let ([n (if count + (format "~a" (inexact->exact (floor count))) + "10")] + [fmt (if (and oneline (not (eq? oneline #f))) + '("--oneline") + '("--format=%h %ad %s" "--date=short"))]) + (log-info logger "git-log" `((count . ,n))) + (let ([cmd (append + (list "log" (string-append "-" n)) + fmt + (if file (list "--" file) '()))]) + (run-git cmd cwd))))) + (def (handle-git-show args) + (let ([ref (hash-ref args "ref" #f)] + [cwd (hash-get args "path")]) + (unless ref + (error 'git_show "Missing required parameter: ref")) + (log-info logger "git-show" `((ref . ,ref))) + (run-git (list "show" "--stat" "--patch" ref) cwd))) + (def (handle-git-commit args) + (let ([message (hash-ref args "message" #f)] + [paths (hash-get args "paths")] + [cwd (hash-get args "path")]) + (unless message + (error 'git_commit "Missing required parameter: message")) + (log-info logger "git-commit" `((message . ,message))) + (when (and paths (not (string=? paths ""))) + (run-git (list "add" paths) cwd)) + (run-git + (list "commit" "-m" (string-append "\"" message "\"")) + cwd)))) --- a/lib/jcode/ui/cli.sls +++ b/lib/jcode/ui/cli.sls @@ -8,11 +8,11 @@ (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name) - (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) (jcode tool batch) (jerboa core) - (jerboa runtime)) + (std misc string) (std text json) (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) (jcode tool batch) + (jcode tool git) (jerboa core) (jerboa runtime)) (def logger (make-logger "cli")) (def *version* "0.1.0") (def (cli-main args) @@ -76,7 +76,7 @@ (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) (init-batch-tool)) + (init-web-tools) (init-batch-tool) (init-git-tools)) (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")) @@ -86,8 +86,22 @@ "Type your message, /help for commands, or Ctrl-D to quit.~n~n") (let ([session (session-create "New session")]) (repl-loop (session-id session)))) + (def (make-prompt) + (let ([provider (or (current-provider-override) + (config-provider))] + [model (or (current-model-override) + (config-ref "model") + (config-default-model + (or (current-provider-override) + (config-provider))))]) + (format + "\x1B;[1;34m~a\x1B;[0m > " + (model-short-name (or model "?"))))) + (def (model-short-name s) + (let ([idx (string-contains s "/")]) + (if idx (substring s (+ idx 1) (string-length s)) s))) (def (repl-loop session-id) - (display "> ") + (display (make-prompt)) (flush-output-port (current-output-port)) (let ([input (get-line (current-input-port))]) (cond @@ -101,42 +115,123 @@ (handle-user-input input session-id) (repl-loop session-id)]))) (def (handle-command input session-id) - (let ([cmd (substring input 1 (string-length input))]) + (let ([cmd (string-trim + (substring input 1 (string-length input)))]) (cond [(equal? cmd "help") (display - "\nCommands:\n /help Show this help\n /model Show current model\n /quit Exit\n\n")] + "\nCommands:\n /help Show this help\n /model Show current model and provider\n /tools List available tools\n /clear Start a new session\n /sessions List saved sessions\n /compact Show message count\n /quit Exit\n\n")] [(equal? cmd "model") + (printf "Provider: ~a~n" (config-provider)) (printf "Model: ~a~n" (config-model)) - (printf "Provider: ~a~n" (config-provider))] + (printf + "API Key: ~a~n" + (if (config-api-key) "configured" "not set"))] + [(equal? cmd "tools") + (printf + "Available tools: ~a~n" + (string-join (list-tools) ", "))] + [(equal? cmd "clear") + (let ([new-session (session-create "New session")]) + (printf "Started new session.~n") + (repl-loop (session-id new-session)))] + [(equal? cmd "sessions") + (let ([sessions (session-list)]) + (if (null? sessions) + (printf "No sessions found.~n") + (for-each + (lambda (s) + (printf + " ~a ~a~n" + (session-id s) + (session-title s))) + sessions)))] + [(equal? cmd "compact") + (let ([msgs (session-get-messages session-id)]) + (printf "Messages in session: ~a~n" (length msgs)))] [(or (equal? cmd "quit") (equal? cmd "exit")) (printf "Goodbye!~n") (exit 0)] - [else (printf "Unknown command: /~a~n" cmd)]))) + [#t (printf "Unknown command: /~a~n" cmd)]))) (def (handle-user-input input session-id) (try (printf "~n") (flush-output-port (current-output-port)) - (parameterize ([current-stream-cb - (lambda (token) - (display token) - (flush-output-port (current-output-port)))]) + (parameterize ([current-stream-cb stream-token] + [current-tool-cb tool-indicator]) (agent-run session-id input)) (printf "~n~n") (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) - (printf "~nError: ~a~n" (err->string e))))) + (printf "~nError: ~a~n" (format-error e))))) (def (one-shot-mode prompt opts) - (try (parameterize ([current-stream-cb - (lambda (token) - (display token) - (flush-output-port (current-output-port)))]) + (try (parameterize ([current-stream-cb stream-token] + [current-tool-cb tool-indicator]) (agent-chat prompt)) (newline) (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) - (printf "Error: ~a~n" (err->string e)) + (printf "Error: ~a~n" (format-error e)) (exit 1)))) + (def (stream-token token) + (display token) + (flush-output-port (current-output-port))) + (def (tool-indicator event name args) + (case event + [(start) + (printf "~n\x1B;[36m⟡ ~a\x1B;[0m" name) + (let ([summary (tool-args-summary name args)]) + (when summary (printf " \x1B;[2m~a\x1B;[0m" summary))) + (newline) + (flush-output-port (current-output-port))] + [(end) (void)])) + (def (tool-args-summary name args) + (cond + [(or (equal? name "read") + (equal? name "write") + (equal? name "edit") + (equal? name "glob") + (equal? name "ls")) + (hash-get args "path")] + [(equal? name "grep") + (let ([pat (hash-get args "pattern")] + [path (hash-get args "path")]) + (if pat (format "~a in ~a" pat (or path ".")) #f))] + [(equal? name "bash") + (let ([cmd (hash-get args "command")]) + (if (and cmd (> (string-length cmd) 60)) + (string-append (substring cmd 0 57) "...") + cmd))] + [(equal? name "git_status") (or (hash-get args "path") ".")] + [(equal? name "git_diff") + (or (hash-get args "file") (hash-get args "ref") "")] + [(equal? name "git_log") (or (hash-get args "file") "")] + [(equal? name "git_show") (hash-get args "ref")] + [(equal? name "git_commit") (hash-get args "message")] + [#t #f])) + (def (format-error e) + (let ([msg (err->string e)]) + (let ([idx (string-contains msg "API error")]) + (if idx + (let ([json-start (string-contains msg "{")]) + (if json-start + (guard (ex [list #t msg]) + (let* ([json-str (substring + msg + json-start + (string-length msg))] + [json (string->json-object json-str)] + [err-obj (or (hash-get json "error") json)] + [emsg (if (hash-table? err-obj) + (or (hash-get err-obj "message") + (json-object->string err-obj)) + (format "~a" err-obj))]) + (format + "~a: ~a" + (substring msg idx json-start) + emsg))) + msg)) + msg)))) (def (session-command args) (cond [(or (null? args) (equal? (car args) "list")) --- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -4,6 +4,7 @@ agent-chat agent-step current-stream-cb + current-tool-cb current-provider-override current-model-override) @@ -21,21 +22,27 @@ (def current-model-override (make-parameter #f)) (def (system-prompt) - "You are an expert AI coding assistant. You help users with software development tasks. + (format "You are an expert AI coding assistant. You help users with software development tasks. +Working directory: ~a -You have access to tools that let you: -- Read and write files -- Execute shell commands -- Search code and files +You have access to these tools: +- read, write, edit, multi-edit: Read and modify files +- glob, grep, ls: Search and list files +- bash: Execute shell commands +- fetch: HTTP requests +- batch: Run multiple tool calls in parallel +- git_status, git_diff, git_log, git_show, git_commit: Git operations When the user asks you to do something: 1. Think about what tools you need 2. Use tools to gather information or make changes 3. Report back with results -Be concise and helpful. When editing files, make minimal changes.") +Be concise and helpful. When editing files, make minimal targeted changes. +Prefer using the edit tool over write for modifying existing files." (current-directory))) (def current-stream-cb (make-parameter #f)) +(def current-tool-cb (make-parameter #f)) (def (agent-run session-id user-input) (log-info logger "agent-run" `((session . ,session-id))) @@ -84,9 +91,12 @@ Be concise and helpful. When editing files, make minimal changes.") (def (execute-single-tool tc) (let* ((name (tool-call-name tc)) (args (string->json-object (tool-call-arguments tc))) - (result (tool-execute name args))) - (log-debug logger "tool-result" `((tool . ,name) (result-length . ,(string-length result)))) - (make-tool-result (tool-call-id tc) result))) + (cb (current-tool-cb))) + (when cb (cb 'start name args)) + (let ((result (tool-execute name args))) + (log-debug logger "tool-result" `((tool . ,name) (result-length . ,(string-length result)))) + (when cb (cb 'end name args)) + (make-tool-result (tool-call-id tc) result)))) (def (get-current-provider) (let* ((provider-name (or (current-provider-override) (config-provider))) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -10,11 +10,27 @@ (import :std/text/json :std/net/request :std/misc/string + :std/misc/retry :jcode/core/log :jcode/core/message) (def logger (make-logger "provider")) +;; Retry policy for transient API errors (429, 5xx) +(def *api-retry-policy* (make-retry-policy 3 1.0 30.0 #t)) + +(def (retryable-error? e) + ;; Check if the error message contains a retryable HTTP status + (let ((msg (with-output-to-string (lambda () (display-condition e))))) + (or (string-contains msg "429") + (string-contains msg "500") + (string-contains msg "502") + (string-contains msg "503") + (string-contains msg "529")))) + +(def (api-call-with-retry thunk) + (retry/predicate thunk retryable-error? 3 1.0)) + ;; Private struct — public make-provider is the smart constructor below (defstruct provider-record (name api-key model base-url)) @@ -50,12 +66,14 @@ `((provider . ,(provider-name provider)) (model . ,(provider-model provider)) (messages . ,(length messages)))) - (case (string->symbol (provider-name provider)) - ((openai openrouter deepseek) (openai-chat provider messages tools)) - ((anthropic) (anthropic-chat provider messages tools)) - ((google) (google-chat provider messages tools)) - ((ollama) (ollama-chat provider messages tools)) - (else (error 'provider-chat "Unknown provider" (provider-name provider))))) + (api-call-with-retry + (lambda () + (case (string->symbol (provider-name provider)) + ((openai openrouter deepseek) (openai-chat provider messages tools)) + ((anthropic) (anthropic-chat provider messages tools)) + ((google) (google-chat provider messages tools)) + ((ollama) (ollama-chat provider messages tools)) + (else (error 'provider-chat "Unknown provider" (provider-name provider))))))) (def (provider-stream provider messages tools callback) (let ((response (provider-chat provider messages tools))) new file mode 100644 --- /dev/null +++ b/src/jcode/tool/git.ss @@ -0,0 +1,140 @@ +;;; jcode git tools — status, diff, log, show, commit + +(export init-git-tools) + +(import :std/os/shell + :std/misc/string + :jcode/core/log + :jcode/tool/registry) + +(def logger (make-logger "tool.git")) + +(def (init-git-tools) + (register-tool! "git_status" + "Show the working tree status. Returns modified, staged, and untracked files." + (make-git-schema + '(("path" "string" "Repository path (default: current directory)" #f))) + handle-git-status) + (register-tool! "git_diff" + "Show changes in the working tree or between commits." + (make-git-schema + '(("path" "string" "Repository path (default: current directory)" #f) + ("staged" "boolean" "Show staged changes only (default: false)" #f) + ("ref" "string" "Compare against a specific ref (branch, tag, commit)" #f) + ("file" "string" "Limit diff to a specific file" #f))) + handle-git-diff) + (register-tool! "git_log" + "Show recent commit history." + (make-git-schema + '(("path" "string" "Repository path (default: current directory)" #f) + ("count" "number" "Number of commits to show (default: 10)" #f) + ("oneline" "boolean" "Show compact one-line format (default: true)" #f) + ("file" "string" "Show history for a specific file" #f))) + handle-git-log) + (register-tool! "git_show" + "Show the contents of a specific commit." + (make-git-schema + '(("ref" "string" "Commit hash, branch, or tag to show" #t) + ("path" "string" "Repository path (default: current directory)" #f))) + handle-git-show) + (register-tool! "git_commit" + "Create a git commit with the given message. Only commits already-staged files unless paths are specified." + (make-git-schema + '(("message" "string" "Commit message" #t) + ("paths" "string" "Space-separated paths to stage before committing" #f) + ("path" "string" "Repository path (default: current directory)" #f))) + handle-git-commit)) + +;; --- schema helper (same as file.ss make-schema) --- + +(def (make-git-schema params) + (let ((schema (make-hash-table)) + (properties (make-hash-table)) + (required '())) + (hash-put! schema "type" "object") + (for-each + (lambda (param) + (let ((name (car param)) + (type (cadr param)) + (desc (caddr param)) + (req? (cadddr param)) + (prop (make-hash-table))) + (hash-put! prop "type" type) + (hash-put! prop "description" desc) + (hash-put! properties name prop) + (when req? + (set! required (cons name required))))) + params) + (hash-put! schema "properties" properties) + (hash-put! schema "required" (reverse required)) + schema)) + +;; --- git command runner --- + +(def (run-git args . opts) + (let ((cwd (if (pair? opts) (car opts) #f))) + (try + (let-values (((stdout stderr exit-code) (shell/status (git-cmd args) cwd))) + (if (= exit-code 0) + (string-trim stdout) + (format "git error (exit ~a): ~a" exit-code + (string-trim (if (string=? stderr "") stdout stderr))))) + (catch (e) + (format "Error: ~a" (err->string e)))))) + +(def (git-cmd args) + (string-join (cons "git" args) " ")) + +;; --- handlers --- + +(def (handle-git-status args) + (let ((cwd (hash-get args "path"))) + (log-info logger "git-status" (if cwd `((path . ,cwd)) '())) + (run-git '("status" "--short" "--branch") cwd))) + +(def (handle-git-diff args) + (let ((cwd (hash-get args "path")) + (staged (hash-get args "staged")) + (ref (hash-get args "ref")) + (file (hash-get args "file"))) + (log-info logger "git-diff" `((staged . ,staged) (ref . ,ref))) + (let ((cmd (append '("diff") + (if staged '("--cached") '()) + (if ref (list ref) '()) + (if file (list "--" file) '())))) + (run-git cmd cwd)))) + +(def (handle-git-log args) + (let ((cwd (hash-get args "path")) + (count (hash-get args "count")) + (oneline (hash-get args "oneline")) + (file (hash-get args "file"))) + (let ((n (if count (format "~a" (inexact->exact (floor count))) "10")) + (fmt (if (and oneline (not (eq? oneline #f))) + '("--oneline") + '("--format=%h %ad %s" "--date=short")))) + (log-info logger "git-log" `((count . ,n))) + (let ((cmd (append (list "log" (string-append "-" n)) + fmt + (if file (list "--" file) '())))) + (run-git cmd cwd))))) + +(def (handle-git-show args) + (let ((ref (hash-ref args "ref" #f)) + (cwd (hash-get args "path"))) + (unless ref + (error 'git_show "Missing required parameter: ref")) + (log-info logger "git-show" `((ref . ,ref))) + (run-git (list "show" "--stat" "--patch" ref) cwd))) + +(def (handle-git-commit args) + (let ((message (hash-ref args "message" #f)) + (paths (hash-get args "paths")) + (cwd (hash-get args "path"))) + (unless message + (error 'git_commit "Missing required parameter: message")) + (log-info logger "git-commit" `((message . ,message))) + ;; Stage paths if specified + (when (and paths (not (string=? paths ""))) + (run-git (list "add" paths) cwd)) + (run-git (list "commit" "-m" (string-append "\"" message "\"")) cwd))) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -3,6 +3,7 @@ (export cli-main) (import :std/misc/string + :std/text/json :jcode/core/config :jcode/core/log :jcode/core/session @@ -12,7 +13,8 @@ :jcode/tool/file :jcode/tool/bash :jcode/tool/web - :jcode/tool/batch) + :jcode/tool/batch + :jcode/tool/git) (def logger (make-logger "cli")) (def *version* "0.1.0") @@ -70,7 +72,8 @@ (init-file-tools) (init-bash-tool) (init-web-tools) - (init-batch-tool)) + (init-batch-tool) + (init-git-tools)) (def (display-help) (display "\ @@ -104,8 +107,19 @@ EXAMPLES: (let ((session (session-create "New session"))) (repl-loop (session-id session)))) +(def (make-prompt) + (let ((provider (or (current-provider-override) (config-provider))) + (model (or (current-model-override) (config-ref "model") + (config-default-model (or (current-provider-override) (config-provider)))))) + (format "\x1b;[1;34m~a\x1b;[0m > " (model-short-name (or model "?"))))) + +(def (model-short-name s) + ;; Extract last segment: "anthropic/claude-sonnet-4" → "claude-sonnet-4" + (let ((idx (string-contains s "/"))) + (if idx (substring s (+ idx 1) (string-length s)) s))) + (def (repl-loop session-id) - (display "> ") + (display (make-prompt)) (flush-output-port (current-output-port)) (let ((input (get-line (current-input-port)))) (cond @@ -122,45 +136,113 @@ EXAMPLES: (repl-loop session-id))))) (def (handle-command input session-id) - (let ((cmd (substring input 1 (string-length input)))) + (let ((cmd (string-trim (substring input 1 (string-length input))))) (cond ((equal? cmd "help") - (display "\nCommands:\n /help Show this help\n /model Show current model\n /quit Exit\n\n")) + (display "\nCommands:\n /help Show this help\n /model Show current model and provider\n /tools List available tools\n /clear Start a new session\n /sessions List saved sessions\n /compact Show message count\n /quit Exit\n\n")) ((equal? cmd "model") + (printf "Provider: ~a~n" (config-provider)) (printf "Model: ~a~n" (config-model)) - (printf "Provider: ~a~n" (config-provider))) + (printf "API Key: ~a~n" (if (config-api-key) "configured" "not set"))) + ((equal? cmd "tools") + (printf "Available tools: ~a~n" (string-join (list-tools) ", "))) + ((equal? cmd "clear") + (let ((new-session (session-create "New session"))) + (printf "Started new session.~n") + (repl-loop (session-id new-session)))) + ((equal? cmd "sessions") + (let ((sessions (session-list))) + (if (null? sessions) + (printf "No sessions found.~n") + (for-each + (lambda (s) + (printf " ~a ~a~n" (session-id s) (session-title s))) + sessions)))) + ((equal? cmd "compact") + (let ((msgs (session-get-messages session-id))) + (printf "Messages in session: ~a~n" (length msgs)))) ((or (equal? cmd "quit") (equal? cmd "exit")) (printf "Goodbye!~n") (exit 0)) - (else + (#t (printf "Unknown command: /~a~n" cmd))))) (def (handle-user-input input session-id) (try (printf "~n") (flush-output-port (current-output-port)) - (parameterize ((current-stream-cb - (lambda (token) - (display token) - (flush-output-port (current-output-port))))) + (parameterize ((current-stream-cb stream-token) + (current-tool-cb tool-indicator)) (agent-run session-id input)) (printf "~n~n") (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) - (printf "~nError: ~a~n" (err->string e))))) + (printf "~nError: ~a~n" (format-error e))))) (def (one-shot-mode prompt opts) (try - (parameterize ((current-stream-cb - (lambda (token) - (display token) - (flush-output-port (current-output-port))))) + (parameterize ((current-stream-cb stream-token) + (current-tool-cb tool-indicator)) (agent-chat prompt)) (newline) (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) - (printf "Error: ~a~n" (err->string e)) + (printf "Error: ~a~n" (format-error e)) (exit 1)))) +(def (stream-token token) + (display token) + (flush-output-port (current-output-port))) + +(def (tool-indicator event name args) + (case event + ((start) + (printf "~n\x1b;[36m⟡ ~a\x1b;[0m" name) + (let ((summary (tool-args-summary name args))) + (when summary (printf " \x1b;[2m~a\x1b;[0m" summary))) + (newline) + (flush-output-port (current-output-port))) + ((end) (void)))) + +(def (tool-args-summary name args) + (cond + ((or (equal? name "read") (equal? name "write") (equal? name "edit") + (equal? name "glob") (equal? name "ls")) + (hash-get args "path")) + ((equal? name "grep") + (let ((pat (hash-get args "pattern")) + (path (hash-get args "path"))) + (if pat (format "~a in ~a" pat (or path ".")) #f))) + ((equal? name "bash") + (let ((cmd (hash-get args "command"))) + (if (and cmd (> (string-length cmd) 60)) + (string-append (substring cmd 0 57) "...") + cmd))) + ((equal? name "git_status") (or (hash-get args "path") ".")) + ((equal? name "git_diff") (or (hash-get args "file") (hash-get args "ref") "")) + ((equal? name "git_log") (or (hash-get args "file") "")) + ((equal? name "git_show") (hash-get args "ref")) + ((equal? name "git_commit") (hash-get args "message")) + (#t #f))) + +(def (format-error e) + ;; Extract a concise message from API errors + (let ((msg (err->string e))) + (let ((idx (string-contains msg "API error"))) + (if idx + ;; Try to extract just status + JSON message field + (let ((json-start (string-contains msg "{"))) + (if json-start + (guard (ex [#t msg]) + (let* ((json-str (substring msg json-start (string-length msg))) + (json (string->json-object json-str)) + (err-obj (or (hash-get json "error") json)) + (emsg (if (hash-table? err-obj) + (or (hash-get err-obj "message") (json-object->string err-obj)) + (format "~a" err-obj)))) + (format "~a: ~a" (substring msg idx json-start) emsg))) + msg)) + msg)))) + (def (session-command args) (cond ((or (null? args) (equal? (car args) "list"))