core/tool/ui: Claude-Code parity feature scaffolds
ober
a28a375bb153b47dd8869ddd5c609aa66872cd87
new file mode 100644 --- /dev/null +++ b/src/jcode/core/prompts.ss @@ -0,0 +1,177 @@ +;;; jcode prompt profiles +;;; +;;; Prompt profiles are persistent session posture, separate from one-shot +;;; skills. Built-ins are available without files; users can override or add +;;; profiles with markdown files under: +;;; +;;; ./prompts/<name>.md +;;; ./.jcode/prompts/<name>.md +;;; ~/.jcode/prompts/<name>.md + +(export current-prompt-name + current-prompt-body + prompt-list + prompt-load! + prompt-clear! + prompt-active-instructions + prompt-regenerate-defaults!) + +(import :std/os/path + :std/misc/ports + :std/misc/string + ./config) + +(def current-prompt-name (make-parameter #f)) +(def current-prompt-body (make-parameter #f)) + +(def *builtin-prompts* + (list + (cons "ask" + (string-append + "## Ask Mode\n\n" + "You are in read-only answering mode. Use read, ls, glob, grep, git_status, git_diff, git_log, git_show, fetch, and web_search when needed. Do not edit files, run bash, or make project changes. If the user asks for implementation, explain what would change and ask them to switch modes. Cite concrete files and symbols when answering code questions.")) + (cons "brainstorm" + (string-append + "## Brainstorm Mode\n\n" + "Explore options and tradeoffs without writing code. Separate facts from assumptions. Offer two or three concrete approaches when useful, recommend one, and call out risks or unknowns. Do not make implementation edits until the user asks for them.")) + (cons "code" + (string-append + "## Code Mode\n\n" + "Implement requested changes directly. Read relevant files before editing, keep changes scoped, follow existing project patterns, and verify with the narrowest useful tests plus the project build when Scheme files change. Prefer edit, multi-edit, edit_block, or apply_patch over complete rewrites.")) + (cons "debug" + (string-append + "## Debug Mode\n\n" + "Find the root cause before changing code. Reproduce or inspect the failing path, compare working and broken examples, form one hypothesis at a time, then make the smallest fix that addresses the root cause. If multiple fixes fail, stop and reassess the architecture or assumptions.")) + (cons "frontend-design" + (string-append + "## Frontend Design Mode\n\n" + "Build production-grade interfaces that fit the app's domain and existing design system. Prioritize usable workflows, responsive layout, accessibility, and visual polish. Avoid generic decorative layouts when the user asked for an actual tool or app.")) + (cons "plan" + (string-append + "## Planning Mode\n\n" + "Investigate the codebase and produce an implementation plan. Do not write code or tests in this profile unless the user explicitly approves implementation. Include exact files to touch, verification steps, and open questions.")) + (cons "review" + (string-append + "## Review Mode\n\n" + "Review for correctness, regressions, missing tests, maintainability, and integration risk. Findings come first, ordered by severity, with precise file references. If there are no blocking issues, say so clearly and mention residual test gaps.")) + (cons "review-security" + (string-append + "## Security Review Mode\n\n" + "Report only high-confidence exploitable vulnerabilities. Trace attacker-controlled inputs to sensitive sinks before flagging. Skip theoretical best-practice issues unless they create concrete risk. Include impact and a practical fix for each finding.")) + (cons "simplify" + (string-append + "## Simplify Mode\n\n" + "Improve clarity while preserving behavior. Reduce duplication and nesting, keep public APIs stable, avoid clever rewrites, and verify that behavior did not change. Focus on recently modified or requested code.")) + (cons "write-prompt" + (string-append + "## Prompt Writing Mode\n\n" + "Create or refine prompts by first capturing the task contract: objective, non-goals, target model, inputs, tools, output shape, success criteria, and failure cases. Keep policy, examples, and task-local facts clearly separated.")))) + +(def (prompt-dirs) + (let ((home (getenv "HOME")) + (cwd (current-directory))) + (append + (list (path-join cwd "prompts") + (path-join cwd ".jcode" "prompts")) + (if home (list (path-join (jcode-home) "prompts")) '())))) + +(def (prompt-list) + "Return sorted prompt profile names from built-ins and prompt dirs." + (let ((seen (make-hash-table))) + (for-each (lambda (p) (hash-put! seen (car p) #t)) *builtin-prompts*) + (for-each + (lambda (dir) + (when (and (file-exists? dir) (file-directory? dir)) + (for-each + (lambda (entry) + (when (string-suffix? ".md" entry) + (hash-put! seen (strip-md-extension entry) #t))) + (safe-directory-list dir)))) + (prompt-dirs)) + (list-sort string<? (hash-keys seen)))) + +(def (prompt-load! name) + "Activate prompt profile NAME. Returns #t on success, #f if not found." + (cond + ((or (not name) (string=? name "") (string=? name "default") (string=? name "none")) + (prompt-clear!) + #t) + (else + (let ((body (prompt-body name))) + (cond + (body + (current-prompt-name name) + (current-prompt-body body) + #t) + (else #f)))))) + +(def (prompt-clear!) + (current-prompt-name #f) + (current-prompt-body #f)) + +(def (prompt-active-instructions) + "Return a system-prompt block for the active prompt, or the empty string." + (let ((name (current-prompt-name)) + (body (current-prompt-body))) + (if (and name body) + (format "--- Active prompt profile: ~a ---\n~a\n--- End active prompt profile ---\n" + name body) + ""))) + +(def (prompt-regenerate-defaults!) + "Write built-in prompt profiles to ~/.jcode/prompts. Existing files are overwritten." + (let ((dir (path-join (jcode-home) "prompts"))) + (mkdir-p dir) + (for-each + (lambda (p) + (write-file-string + (path-join dir (string-append (car p) ".md")) + (cdr p))) + *builtin-prompts*) + dir)) + +(def (prompt-body name) + (or (prompt-file-body name) + (let ((p (assoc name *builtin-prompts*))) + (and p (cdr p))))) + +(def (prompt-file-body name) + (let loop ((dirs (prompt-dirs))) + (cond + ((null? dirs) #f) + (else + (let ((path (path-join (car dirs) (string-append name ".md")))) + (if (and (file-exists? path) (not (file-directory? path))) + (strip-frontmatter (read-file-string path)) + (loop (cdr dirs)))))))) + +(def (strip-md-extension entry) + (substring entry 0 (- (string-length entry) 3))) + +(def (strip-frontmatter text) + (let ((lines (string-split text #\newline))) + (cond + ((or (null? lines) (not (string=? (car lines) "---"))) + text) + (else + (let loop ((rest (cdr lines))) + (cond + ((null? rest) text) + ((string=? (car rest) "---") (string-join (cdr rest) "\n")) + (else (loop (cdr rest))))))))) + +(def (safe-directory-list dir) + (guard (e [#t '()]) + (filter (lambda (name) + (not (or (string=? name ".") (string=? name "..")))) + (directory-list dir)))) + +(def (mkdir-p dir) + (unless (file-exists? dir) + (let ((parent (path-directory dir))) + (when (and parent + (not (string=? parent "")) + (not (equal? parent dir)) + (not (file-exists? parent))) + (mkdir-p parent)) + (mkdir dir))))