Initial commit: jerboa-slack module
ober
5debd3735243ad6d0d8f2d64a4eb305476f0b583
new file mode 100644 --- /dev/null +++ b/AGENTS.md @@ -0,0 +1,521 @@ +## The Jerboa Language — Quick Reference + +Jerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files. + +### File Structure + +Every Jerboa file looks like this: + +```scheme +(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language +;; Optional extra imports for modules NOT in the prelude: +;; (import (std net request)) + +(def (my-function x y) + (+ x y)) + +(displayln (my-function 1 2)) +``` + +Run with: `jerboa run file.ss` + +**NEVER** write `(library ...)` forms — that's `.sls` internal syntax. + +### Reader Syntax Extensions + +``` +[...] → plain parentheses — same as Gerbil and Chez Scheme +{method obj args} → (~ obj 'method args) — method dispatch +name: → keyword #:name +:std/sort → (std sort) — Gerbil-style module path +#<<END ... END → heredoc string +``` + +Square brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses: +```scheme +;; All of these are correct: +(let ([x 1] [y 2]) (+ x y)) +(for/collect ([x (in-range 5)]) (* x x)) +(match val ([list a b] (+ a b))) +(cond [(> x 0) "positive"] [else "non-positive"]) +``` + +### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez + +Claude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data. +**NONE of them are real in Jerboa/Chez. STOP and use the correct form.** + +#### AI Compatibility Aliases (these now work in the prelude) +The following names from other Scheme dialects are aliased in `(jerboa prelude)`: +- `hash-has-key?` → `hash-key?` (Racket) +- `hash-table-set!` → `hash-put!` (Racket) +- `directory-exists?` → `file-directory?` (Gambit) +- `eql?` → `eqv?` (Common Lisp) +- `random-integer` → `random` (Gambit) +- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg +- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg +- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)` + +#### Hallucinated Functions (still do NOT exist) +- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))` +- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean) +- `define-struct` — use `(defstruct name (fields ...))` +- `raise` with a string — use `(error 'who "message" irritants ...)` +- `environment-bound?` — Gerbil-only. No direct Chez equivalent + +#### Gerbil/Gambit-isms (from training data — wrong in Jerboa) +- `time->seconds` — use `(time-second (current-time))` for epoch seconds +- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))` +- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround +- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version +- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa +- `user-info-home` — Gerbil. Use `(getenv "HOME")` +- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez +- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))` +- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa +- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually +- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API + +#### R6RS/Racket-isms (wrong variant) +- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude +- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez +- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa + +### CRITICAL: Common Arity Mistakes + +- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)` +- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)` +- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)` +- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)` +- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split "a,b" #\,)` +- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not) +- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg) +- `(sort list predicate)` — Jerboa `(std sort)`/prelude order. Raw Chez `sort` is predicate-first, but Jerboa-facing code should use list first. + +### Core Forms (all from `(import (jerboa prelude))`) + +#### Definitions +```scheme +(def x 42) ;; variable +(def (f x y) (+ x y)) ;; function +(def (f x (y 10)) body) ;; optional param with default +(def (f x . rest) body) ;; rest args +(def* f ((x) ...) ((x y) ...)) ;; multi-arity +(defrule (name pat) template) ;; macro +``` + +#### Data Structures +```scheme +(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set! +(defstruct (circle shape) (radius)) ;; inheritance (single only) +(defmethod (area (self circle)) body) ;; method on type +(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...}) +(defrecord person (name age)) ;; struct + pretty-print + ->alist +(define-enum color (red green blue)) ;; → color-red, color?, color->name +``` + +#### Pattern Matching +```scheme +(match value + (42 "exact") ;; literal + ((list a b c) (+ a b c)) ;; list destructure + ((cons h t) h) ;; pair + ((? number?) "num") ;; predicate + ((? string? s) (string-upcase s)) ;; predicate + bind + ((and (? number?) (? positive?)) "positive number") + ((or "yes" "y") #t) + ((=> string->number n) n) ;; view pattern + (n (where (> n 0)) "positive") ;; guard + (_ "default")) ;; wildcard +``` + +#### Error Handling +```scheme +(try expr (catch (e) handler) (finally cleanup)) +(try expr (catch (error? e) handler)) +(unwind-protect body cleanup) +(with-resource (var init cleanup) body) +``` + +#### Result Type (Rust-inspired ok/err) +```scheme +(ok 42) (err "bad") (ok? r) (err? r) +(unwrap (ok 42)) ;; → 42 (raises on err) +(unwrap-or (err "x") 0) ;; → 0 +(map-ok f result) (map-err f result) +(and-then result f) ;; monadic bind +(try-result expr) ;; exceptions → (err condition) +(try-result* expr) ;; exceptions → (err "message string") +(sequence-results list-of-results) ;; → (ok list) or first (err) +(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err +``` + +#### Iterators +```scheme +(for ((x (in-range 5))) (displayln x)) +(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16) +(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45 +(for/or ((x lst)) (and (pred? x) x)) ;; first truthy +(for/and ((x lst)) (pred? x)) ;; all truthy + +;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys, +;; in-hash-values, in-hash-pairs, in-naturals, in-indexed, +;; in-port, in-lines, in-chars, in-bytes, in-producer +``` + +#### Threading Macros +```scheme +(-> x (f a) (g b)) ;; thread first: (g (f x a) b) +(->> x (f a) (g b)) ;; thread last: (g b (f a x)) +(as-> x v (f v) (g v)) ;; named +(some-> x (f) (g)) ;; short-circuit on #f +(cond-> x test (f) t2 (g)) ;; conditional steps +(->? (ok x) (f) (g)) ;; result-aware thread first +``` + +#### Ergo Typing +```scheme +(: expr pred?) ;; checked cast +(using (p (make-point 1 2) : point?) + (+ p.x p.y)) ;; dot-access → (point-x p) etc. +((list-of? number?) '(1 2 3)) ;; predicate factory → #t +((maybe string?) #f) ;; accepts #f or string → #t +``` + +#### Hash Tables +```scheme +(def ht (make-hash-table)) +(hash-put! ht "key" "val") +(hash-ref ht "key") ;; error if missing +(hash-ref ht "key" "default") ;; with default +(hash-get ht "key") ;; → val or #f +(hash-key? ht "key") ;; → #t/#f +(hash-remove! ht "key") +(hash->list ht) (hash-keys ht) (hash-values ht) +(hash-for-each (lambda (k v) ...) ht) +(list->hash-table '(("a" . 1) ("b" . 2))) +``` + +#### Strings +```scheme +(string-split "a,b,c" #\,) ;; → ("a" "b" "c") NOTE: char delimiter +(string-join '("a" "b") ",") ;; → "a,b" +(string-trim " hi ") ;; → "hi" +(string-prefix? "he" "hello") ;; → #t +(string-suffix? "lo" "hello") ;; → #t +(string-contains "hello" "ell") ;; → 1 (index, not boolean!) +(string-empty? "") ;; → #t +(str "age: " 42 "!") ;; → "age: 42!" (auto-coerce) +``` + +#### Lists +```scheme +(flatten '(1 (2 (3)))) ;; → (1 2 3) +(unique '(1 2 2 3)) ;; → (1 2 3) +(take lst n) (drop lst n) (take-last lst n) (drop-last lst n) +(every pred lst) (any pred lst) (filter-map f lst) +(group-by f lst) (zip lst1 lst2) (frequencies lst) +(partition pred lst) (interleave l1 l2) (mapcat f lst) +(distinct lst) (keep f lst) (split-at lst n) +(append-map f lst) (snoc lst elem) +``` + +#### Functional Combinators +```scheme +(compose f g) (comp f g) ;; (f (g x)) +(partial f arg ...) ;; partial application +(complement pred) (negate pred) ;; logical not +(identity x) (constantly v) ;; basic combinators +(curry f arg) (flip f) ;; currying, arg swap +(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR +(juxt f g) ;; → (lambda (x) (list (f x) (g x))) +(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y)) +``` + +#### JSON +```scheme +(string->json-object "{\"key\":\"val\"}") ;; → hash table +(json-object->string ht) ;; → JSON string +(read-json port) (write-json obj port) +``` + +#### CSV +```scheme +(csv->alists "name,age\nAlice,30") ;; → (((name . "Alice") (age . "30"))) +(read-csv-file "data.csv") ;; → list of row lists +(write-csv-file "out.csv" rows) +``` + +#### DateTime +```scheme +(datetime-now) (datetime-utc-now) +(make-datetime 2026 3 27 12 0 0) +(parse-datetime "2026-03-27T12:00:00Z") +(datetime->iso8601 dt) (datetime->epoch dt) +(datetime-add dt duration) (datetime-diff dt1 dt2) +(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024) +``` + +#### Paths +```scheme +(path-join "/home" "user" "f.txt") ;; → "/home/user/f.txt" +(path-directory "/a/b/f.txt") ;; → "/a/b" +(path-extension "file.txt") ;; → "txt" +(path-absolute? "/home") ;; → #t +``` + +#### File I/O +```scheme +(read-file-string "f.txt") ;; → entire file +(read-file-lines "f.txt") ;; → list of lines +(write-file-string "f.txt" "data") +``` + +#### Pretty Printing +```scheme +(pp expr) (pp-to-string expr) (pprint expr) +``` + +#### Formatting +```scheme +(format "~a is ~a" "Alice" 30) ;; → "Alice is 30" +(printf "x = ~a\n" 42) +(displayln "hello" " " "world") +``` + +#### Anaphoric / Conditional Binding +```scheme +(awhen (find x) (use it)) ;; binds result to `it` +(aif (find x) (use it) (default)) +(when-let (x (find y)) (use x)) +(if-let (x (find y)) (use x) (default)) +``` + +#### Loops +```scheme +(while test body ...) +(until test body ...) +(dotimes (i 10) body ...) ;; 0..9 +``` + +#### Misc Sugar +```scheme +(assert! (> x 0)) (assert! (> x 0) "message") +(alist (name "Alice") (age 30)) ;; → ((name . "Alice") (age . 30)) +(let-alist data (name age) body) +``` + +### What's NOT in the Prelude (requires separate import) + +```scheme +(import (std net request)) ;; HTTP client +(import (std net httpd)) ;; HTTP server +(import (std db sqlite)) ;; SQLite +(import (std actor)) ;; Actor system +(import (std async)) ;; Async/await +(import (std crypto digest)) ;; SHA, MD5 +(import (std text regex)) ;; Regex +(import (std text xml)) ;; XML +(import (std text yaml)) ;; YAML +(import (std os env)) ;; Environment variables +(import (std os signal)) ;; Signal handling +(import (std security sandbox)) ;; Sandboxing +``` + +### Chez Scheme Conflicts (handled by prelude) + +The prelude shadows these Chez builtins with Jerboa versions: +`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`, +`path-extension`, `path-absolute?`, `with-input-from-string`, +`with-output-to-string`, `iota`, `1+`, `1-`, `partition`, +`make-date`, `make-time` + +All standard Chez Scheme is still available — the prelude just re-exports +improved versions of the above. + +--- + +## Repository Boundaries + +When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path. + +Common sibling repos that exist but must NOT be touched without explicit instruction: +- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it. +- `~/mine/jerboa-mcp` — Legacy node MCP, superseded. The active MCP server now lives in THIS repo at `mcp/` + `data/`. Don't modify the legacy repo unless told. +- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there. +- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated. +- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify. + +If a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo. + +### Never Reference Sibling Checkouts in Build Files + +Build files (Makefile, shell scripts, CI config) must **never** resolve a +dependency via a relative sibling path (`../jerboa-foo`) or an absolute +`~/mine/jerboa-foo` path. That layout is specific to this one machine — +other users and CI do not have it. Always vendor instead: fetch/clone the +dependency into `vendor/` (or this repo's equivalent) at build time, or use +a pinned-release fetch script, so the build is reproducible without +assuming any sibling checkout exists. + +A sibling-path fallback is not just a portability bug: it can silently +substitute a full alternate source tree (build config, embedded data, +secrets) for the vendored one, with no equivalent safety default, changing +what actually gets built without any indication. If you find one +(`grep -rn '\.\./jerboa\|~/mine/jerboa'` over Makefiles/scripts), remove it +and vendor properly instead. + +--- + +## Build & Verification + +After modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions. + +### Stale Artifacts + +If edits seem to have no effect after `make build`, delete stale compiled files: +```bash +find lib -name "*.so" -delete && find lib -name "*.wpo" -delete && make build +``` +Run `jerboa_stale_static` to detect stale `.so` files before debugging "why doesn't my edit work?". + +## Pre-commit Requirements + +**ALWAYS** run a clean build **before** committing any code to this repository. Pick the right target for the *current* platform: + +- **Linux**: run `make docker-build` — the Docker image must build cleanly against the full musl-static release pipeline. +- **macOS / FreeBSD / other**: run `make binary` — the native local build must succeed. Do **not** run `make docker-build` here; Docker on non-Linux hosts is slow and not the canonical pipeline for those platforms. + +Do not commit if the build fails. + +## Act First, Read Less + +When making changes, read only what you need to make the edit, then make it. +Do not read more than 3 files before acting. Do not re-read files you already +read. Do not verify things you already know. If you have enough context to make +a change, make it. The user will interrupt you if you are wrong. + +## Jerboa MCP Tools — MANDATORY Usage + +Jerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool. + +### MANDATORY Workflow Order (for writing new code) + +1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns +2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities +3. Write the code +4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools) +5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O + +### Essential Tools (use proactively) + +| When | Tool | +|---|---| +| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports | +| Check what a module exports | `jerboa_module_exports` — never guess function names | +| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors | +| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check | +| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths | +| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations | +| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` | +| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` | +| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity | +| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` | +| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` | +| Run tests | `jerboa_run_tests` — prefer over ad hoc shell test invocations | +| Check for stale .so artifacts | `jerboa_stale_static` — common cause of "edit has no effect" | +| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` | +| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature | +| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` | +| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` | +| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits | +| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates | +| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` | +| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` | +| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) | +| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols | +| Read stdlib source | `jerboa_stdlib_source` — see internal implementations | + +### Cookbook & Knowledge Management + +- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes +- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial) +- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work +- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes +- **`jerboa_anti_pattern_lookup`**: Search reusable local-model mistakes and failed strategies + +**The knowledge base is `data/*.sexp` in THIS repo**, embedded into `jmcp` at build time. The write tools above edit it live — the server reads `data/` from disk first, with the embedded copy as fallback (`JERBOA_MCP_REPO` points every client at this repo). When you add a stdlib/language feature, also update `data/` (a cookbook recipe + `api-signatures.sexp` + `changelog.sexp`) and **commit it**. Run `make jmcp` (or `make jmcp-portable`) only to refresh the embedded copy shipped in portable binaries. + +### Code Generation & Refactoring + +`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold` + +### Feature Suggestions + +- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas + +--- + +## MANDATORY: Save What You Learn + +Jerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it. + +### Save to cookbook (`jerboa_howto_add`) whenever you: +- Discover a working pattern through `jerboa_eval` or trial-and-error +- Figure out correct imports, arities, or calling conventions that weren't obvious +- Find a workaround for a Jerboa quirk or undocumented behavior + +**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes. + +**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives). + +### Save anti-patterns (`data/anti-patterns.sexp`) whenever you: +- See a plausible local-model strategy that failed verification +- Find a weak verifier pattern that allowed false success +- See a repeated repair loop, such as broad-reading after a concrete error +- Find a generic runtime mistake, such as missing lower-bound checks before vector access + +**Before saving**: check `jerboa_anti_pattern_lookup` to avoid duplicates. If none exists, call `jerboa_anti_pattern_add`; only edit `data/anti-patterns.sexp` directly if the writer tool is unavailable. Save the normalized reusable mistake, not the whole trace or benchmark name. + +**Anti-pattern format**: `id`, `title`, `kinds`, `severity`, `tags`, `pattern`, `avoid`, `advice`, `tools`. + +### Save error fixes (`jerboa_error_fix_add`) whenever you: +- See exact compiler/runtime/verifier text with a repeatable repair +- Hit an error that `jerboa_failure_advisor` should classify better next time +- Debug a local-model generated-code failure where a short diagnosis prevents another failed iteration + +**Before saving**: check `jerboa_error_fix_lookup` with the exact error text. **Do NOT save**: one-off project business-logic mistakes. + +**Error-fix format**: `id`, `pattern`, `fix`; optional `type`, `explanation`, `code_example`. + +### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you: +- Make multiple sequential tool calls that could be one tool +- Fall back to bash because an MCP tool is missing or insufficient + +**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists. + +### Save Discoveries Mechanisms +- **`/save-discoveries` skill**: invoke anytime to review session and save recipes, anti-patterns, error fixes, feature suggestions, and security patterns +- **PreCompact hook**: add `PreCompact` hook with `type: "prompt"` in `.claude/settings.json` to auto-save before context compaction + +--- + +## Common Workflows + +- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan` +- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns +- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps` +- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts` +- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report` +- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax` +- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles` +- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check` +- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart` +- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint` +- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build` +- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate` +- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type` + +## Workflow Conventions + +When implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system. new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2026 Jaime Fournier + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,10 @@ +.PHONY: verify run + +JERBOA_HOME ?= /Users/user/mine/jerboa +JERBOA ?= $(JERBOA_HOME)/bin/jerboa + +verify: + JERBOA_HOME=$(JERBOA_HOME) $(JERBOA) run jerboa-slack.ss help + +run: + JERBOA_HOME=$(JERBOA_HOME) $(JERBOA) run jerboa-slack.ss tui new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,42 @@ +# jerboa-slack + +Mux-friendly Slack chat client written in Jerboa. + +This repository also keeps a shallow checkout of Slack's official CLI at +`vendor/slack-cli`. That upstream CLI is for Slack app development; this client +uses Slack Web API methods for day-to-day chat. + +## Run + +```sh +export SLACK_BOT_TOKEN='xoxb-...' +JERBOA_HOME=/Users/user/mine/jerboa /Users/user/mine/jerboa/bin/jerboa run jerboa-slack.ss auth-test +JERBOA_HOME=/Users/user/mine/jerboa /Users/user/mine/jerboa/bin/jerboa run jerboa-slack.ss channels +JERBOA_HOME=/Users/user/mine/jerboa /Users/user/mine/jerboa/bin/jerboa run jerboa-slack.ss tui general +``` + +Useful commands: + +```sh +make run +JERBOA_HOME=/Users/user/mine/jerboa /Users/user/mine/jerboa/bin/jerboa run jerboa-slack.ss history general 20 +JERBOA_HOME=/Users/user/mine/jerboa /Users/user/mine/jerboa/bin/jerboa run jerboa-slack.ss send general "hello from jerboa" +JERBOA_HOME=/Users/user/mine/jerboa /Users/user/mine/jerboa/bin/jerboa run jerboa-slack.ss replies general 1712345678.000100 +JERBOA_HOME=/Users/user/mine/jerboa /Users/user/mine/jerboa/bin/jerboa run jerboa-slack.ss reply general 1712345678.000100 "thread reply" +JERBOA_HOME=/Users/user/mine/jerboa /Users/user/mine/jerboa/bin/jerboa run jerboa-slack.ss react general 1712345678.000100 thumbsup +``` + +The TUI is intentionally line-oriented instead of raw-mode curses. Inside the +TUI, use `/help`, `/channels`, `/use <channel>`, `/history [limit]`, `/thread +<ts>`, `/reply <ts> <text>`, `/react <ts> <emoji>`, `/send <text>`, and +`/quit`. A normal non-empty line sends a message to the current channel. + +## Slack Scopes + +The token needs the Slack scopes that match what you want to do, commonly: + +- `channels:read`, `groups:read`, `im:read`, `mpim:read` +- `channels:history`, `groups:history`, `im:history`, `mpim:history` +- `chat:write` +- `reactions:write` +- `users:read` for display names instead of raw Slack user IDs new file mode 100644 --- /dev/null +++ b/jerboa-slack.ss @@ -0,0 +1,418 @@ +#!/usr/bin/env jerboa run + +(import (jerboa prelude) + (std net request) + (std os env)) + +(def api-root "https://slack.com/api/") +(def default-channel-types "public_channel,private_channel,im,mpim") +(def user-cache (make-hash-table)) + +(def (usage) + (displayln "Usage: jerboa run jerboa-slack.ss <command> [args...]") + (displayln "") + (displayln "Commands:") + (displayln " tui [channel] Start mux-friendly chat UI") + (displayln " channels List visible conversations") + (displayln " history <channel> [limit] Show recent messages") + (displayln " send <channel> <text...> Send a message") + (displayln " reply <channel> <ts> <text...>") + (displayln " Reply in a thread") + (displayln " replies <channel> <ts> Show a thread") + (displayln " react <channel> <ts> <emoji>") + (displayln " Add an emoji reaction") + (displayln " auth-test Check token") + (displayln "") + (displayln "Environment:") + (displayln " SLACK_BOT_TOKEN or SLACK_TOKEN must contain a Slack token.")) + +(def (token) + (or (getenv "SLACK_BOT_TOKEN") + (getenv "SLACK_TOKEN") + (begin + (displayln "Missing SLACK_BOT_TOKEN or SLACK_TOKEN") + (exit 2)))) + +(def (auth-headers) + `(("Authorization" . ,(string-append "Bearer " (token))) + ("Content-Type" . "application/json; charset=utf-8"))) + +(def (api-url method params) + (let ([query (if (null? params) "" (string-append "?" (build-query-string params)))]) + (string-append api-root method query))) + +(def (json-hash pairs) + (let ([h (make-hash-table)]) + (for-each (lambda (p) (hash-put! h (car p) (cdr p))) pairs) + h)) + +(def (jref obj key (default #f)) + (if (and (hash-table? obj) (hash-key? obj key)) + (hash-ref obj key) + default)) + +(def (fail who msg . irritants) + (apply error who msg irritants)) + +(def (json-response resp) + (let* ([body (request-text resp)] + [data (string->json-object body)]) + (unless (= (request-status resp) 200) + (fail 'slack-api "HTTP error" (request-status resp) body)) + (unless (jref data "ok" #f) + (fail 'slack-api "Slack API error" (jref data "error" "unknown_error"))) + data)) + +(def (slack-get method params) + (json-response (http-get (api-url method params) (auth-headers) #f))) + +(def (slack-post method payload) + (json-response + (http-post (api-url method '()) + (auth-headers) + (json-object->string payload)))) + +(def (slack-post-form method params) + (json-response + (http-post (api-url method '()) + `(("Authorization" . ,(string-append "Bearer " (token))) + ("Content-Type" . "application/x-www-form-urlencoded")) + (build-query-string params)))) + +(def (vec->list v) + (if (vector? v) (vector->list v) '())) + +(def (safe-line s) + (let ([out (open-output-string)]) + (string-for-each + (lambda (c) + (let ([n (char->integer c)]) + (cond + [(or (= n 9) (= n 10) (>= n 32)) + (unless (= n 27) (write-char c out))] + [else (void)]))) + (if (string? s) s (str s))) + (get-output-string out))) + +(def (conversation-name c) + (or (jref c "name" #f) + (jref c "user" #f) + (jref c "id" ""))) + +(def (conversation-id c) (jref c "id" "")) + +(def (conversation-label c) + (let ([name (conversation-name c)]) + (if (string-prefix? "U" name) name (string-append "#" name)))) + +(def (list-conversations) + (let loop ([cursor #f] [acc '()]) + (let* ([params `(("limit" . "200") + ("exclude_archived" . "true") + ("types" . ,default-channel-types) + ,@(if cursor `(("cursor" . ,cursor)) '()))] + [data (slack-get "conversations.list" params)] + [channels (vec->list (jref data "channels" '#()))] + [meta (jref data "response_metadata" #f)] + [next (and meta (jref meta "next_cursor" ""))]) + (if (and next (not (string=? next ""))) + (loop next (append acc channels)) + (append acc channels))))) + +(def (find-conversation needle conversations) + (for/or ((c conversations)) + (let ([id (conversation-id c)] + [name (conversation-name c)]) + (and (or (string=? needle id) + (string=? needle name) + (string=? needle (string-append "#" name))) + c)))) + +(def (resolve-channel needle) + (or (find-conversation needle (list-conversations)) + (fail 'channel "conversation not found" needle))) + +(def (message-user msg) + (or (jref msg "user" #f) + (jref msg "username" #f) + (jref msg "bot_id" #f) + "unknown")) + +(def (user-display-name user) + (let ([profile (jref user "profile" #f)]) + (or (and profile + (not (string-empty? (jref profile "display_name" ""))) + (jref profile "display_name")) + (and profile + (not (string-empty? (jref profile "real_name" ""))) + (jref profile "real_name")) + (jref user "name" #f) + (jref user "id" "unknown")))) + +(def (lookup-user-name uid) + (cond + [(not (string? uid)) "unknown"] + [(not (string-prefix? "U" uid)) uid] + [(hash-key? user-cache uid) (hash-ref user-cache uid)] + [else + (let ([name (unwrap-or + (try-result* + (let* ([data (slack-get "users.info" `(("user" . ,uid)))] + [user (jref data "user" #f)]) + (if user (user-display-name user) uid))) + uid)]) + (hash-put! user-cache uid name) + name)])) + +(def (message-text msg) + (safe-line (jref msg "text" ""))) + +(def (message-ts msg) + (jref msg "ts" "")) + +(def (message-thread-ts msg) + (jref msg "thread_ts" (message-ts msg))) + +(def (reaction-summary msg) + (let ([reactions (vec->list (jref msg "reactions" '#()))]) + (if (null? reactions) + "" + (string-append + " " + (string-join + (map (lambda (r) + (format ":~a:~a" + (jref r "name" "") + (jref r "count" 0))) + reactions) + " "))))) + +(def (thread-summary msg) + (let ([count (jref msg "reply_count" 0)]) + (if (and (number? count) (> count 0)) + (format " replies:~a thread:~a" count (message-thread-ts msg)) + ""))) + +(def (fetch-history channel-id limit) + (let* ([data (slack-get "conversations.history" + `(("channel" . ,channel-id) + ("limit" . ,(number->string limit))))] + [messages (vec->list (jref data "messages" '#()))]) + (reverse messages))) + +(def (fetch-replies channel-id ts) + (let* ([data (slack-get "conversations.replies" + `(("channel" . ,channel-id) + ("ts" . ,ts)))] + [messages (vec->list (jref data "messages" '#()))]) + messages)) + +(def (print-message msg) + (printf "[~a] ~a: ~a~a~a\n" + (message-ts msg) + (lookup-user-name (message-user msg)) + (message-text msg) + (thread-summary msg) + (reaction-summary msg))) + +(def (cmd-channels) + (for-each + (lambda (c) + (printf "~a\t#~a\n" (conversation-id c) (conversation-name c))) + (list-conversations))) + +(def (cmd-history channel limit) + (let* ([c (resolve-channel channel)] + [cid (conversation-id c)]) + (for-each print-message (fetch-history cid limit)))) + +(def (cmd-send channel text) + (let* ([c (resolve-channel channel)] + [cid (conversation-id c)] + [payload (json-hash `(("channel" . ,cid) ("text" . ,text)))] + [data (slack-post "chat.postMessage" payload)]) + (printf "sent ~a to #~a\n" (jref data "ts" "") (conversation-name c)))) + +(def (cmd-reply channel ts text) + (let* ([c (resolve-channel channel)] + [cid (conversation-id c)] + [payload (json-hash `(("channel" . ,cid) + ("thread_ts" . ,ts) + ("text" . ,text)))] + [data (slack-post "chat.postMessage" payload)]) + (printf "replied ~a in #~a thread ~a\n" + (jref data "ts" "") + (conversation-name c) + ts))) + +(def (cmd-replies channel ts) + (let* ([c (resolve-channel channel)] + [cid (conversation-id c)]) + (for-each print-message (fetch-replies cid ts)))) + +(def (cmd-react channel ts emoji) + (let* ([c (resolve-channel channel)] + [cid (conversation-id c)] + [name (if (and (> (string-length emoji) 1) + (string-prefix? ":" emoji) + (string-suffix? ":" emoji)) + (substring emoji 1 (- (string-length emoji) 1)) + emoji)]) + (slack-post-form "reactions.add" + `(("channel" . ,cid) + ("timestamp" . ,ts) + ("name" . ,name))) + (printf "reacted :~a: to ~a in #~a\n" name ts (conversation-name c)))) + +(def (cmd-auth-test) + (let ([data (slack-get "auth.test" '())]) + (printf "ok: team=~a user=~a\n" + (jref data "team" "") + (jref data "user" "")))) + +(def (clear-screen) + (display "\x1b;[2J\x1b;[H")) + +(def (render-tui current limit) + (clear-screen) + (printf "jerboa-slack channel: #~a (/help for commands)\n" + (conversation-name current)) + (displayln "------------------------------------------------------------") + (for-each print-message (fetch-history (conversation-id current) limit)) + (displayln "------------------------------------------------------------")) + +(def (tui-help) + (displayln "/channels list conversations") + (displayln "/use <channel> switch channel by id or name") + (displayln "/history [limit] redraw recent messages") + (displayln "/thread <ts> show replies for a message") + (displayln "/reply <ts> <text> reply in a thread") + (displayln "/react <ts> <emoji> add an emoji reaction") + (displayln "/send <text> send text to current channel") + (displayln "/help show commands") + (displayln "/quit exit") + (displayln "Any non-empty line that is not a command is sent as a message.")) + +(def (split-command line) + (let ([parts (string-split line #\space)]) + (filter (lambda (x) (not (string-empty? x))) parts))) + +(def (drop-command-prefix line cmd) + (let ([n (string-length cmd)]) + (string-trim + (if (> (string-length line) n) + (substring line n (string-length line)) + "")))) + +(def (run-tui initial) + (let* ([channels (list-conversations)] + [current (if initial + (or (find-conversation initial channels) + (fail 'channel "conversation not found" initial)) + (if (null? channels) + (fail 'slack "no conversations returned") + (car channels)))] + [limit 30]) + (render-tui current limit) + (let loop ([current current] [limit limit]) + (display "> ") + (flush-output-port (current-output-port)) + (let ([line (get-line (current-input-port))]) + (cond + [(eof-object? line) (displayln "")] + [(string-empty? (string-trim line)) (loop current limit)] + [(string=? line "/quit") (displayln "bye")] + [(string=? line "/help") + (tui-help) + (loop current limit)] + [(string=? line "/channels") + (cmd-channels) + (loop current limit)] + [(string-prefix? "/use " line) + (let ([next (resolve-channel (drop-command-prefix line "/use"))]) + (render-tui next limit) + (loop next limit))] + [(string-prefix? "/history" line) + (let* ([arg (drop-command-prefix line "/history")] + [n (if (string-empty? arg) limit (or (string->number arg) limit))]) + (render-tui current n) + (loop current n))] + [(string-prefix? "/thread " line) + (cmd-replies (conversation-id current) (drop-command-prefix line "/thread")) + (loop current limit)] + [(string-prefix? "/reply " line) + (let* ([rest (drop-command-prefix line "/reply")] + [parts (split-command rest)]) + (if (< (length parts) 2) + (displayln "usage: /reply <ts> <text>") + (cmd-reply (conversation-id current) + (car parts) + (drop-command-prefix rest (car parts))))) + (loop current limit)] + [(string-prefix? "/react " line) + (let ([parts (split-command (drop-command-prefix line "/react"))]) + (if (< (length parts) 2) + (displayln "usage: /react <ts> <emoji>") + (cmd-react (conversation-id current) (car parts) (cadr parts)))) + (loop current limit)] + [(string-prefix? "/send " line) + (cmd-send (conversation-id current) (drop-command-prefix line "/send")) + (render-tui current limit) + (loop current limit)] + [(string-prefix? "/" line) + (displayln "unknown command") + (loop current limit)] + [else + (cmd-send (conversation-id current) line) + (render-tui current limit) + (loop current limit)]))))) + +(def (join-words xs) + (string-join xs " ")) + +(def (main argv) + (let ([args (cdr argv)]) + (cond + [(null? args) (usage)] + [(string=? (car args) "channels") (cmd-channels)] + [(string=? (car args) "auth-test") (cmd-auth-test)] + [(string=? (car args) "history") + (unless (>= (length args) 2) + (usage) + (exit 2)) + (cmd-history (cadr args) + (if (>= (length args) 3) + (or (string->number (caddr args)) 30) + 30))] + [(string=? (car args) "send") + (unless (>= (length args) 3) + (usage) + (exit 2)) + (cmd-send (cadr args) (join-words (cddr args)))] + [(string=? (car args) "reply") + (unless (>= (length args) 4) + (usage) + (exit 2))