Add REPL middleware, notebook system, and protocol docs
ober
f3059046a9ddab622a489726bfbd4674dcabd439
new file mode 100644 --- /dev/null +++ b/docs/repl-protocol.md @@ -0,0 +1,282 @@ +# Jerboa REPL Server Protocol + +The Jerboa REPL server provides a SWANK-like protocol for editor integration. Editors connect via TCP and exchange s-expressions. + +## Quick Start + +### Starting the Server + +```scheme +(import (std repl server)) +(define srv (repl-server-start 4233)) ; specific port +(define srv (repl-server-start 0)) ; auto-assign port +(repl-server-port srv) ; → actual port number +(repl-server-stop srv) ; stop +``` + +### Port Discovery + +The server writes `~/.jerboa-repl-port` with: +``` +PORT=4233 +PID=12345 +``` + +Editors should read this file to auto-discover the server port. + +### Connecting + +```bash +# From shell +nc 127.0.0.1 4233 + +# From Emacs Lisp +(open-network-stream "jerboa" buf "127.0.0.1" 4233) +``` + +## Protocol + +### Request Format + +``` +(id method arg1 arg2 ...) +``` + +- `id`: integer — unique request identifier, echoed in response +- `method`: symbol — the operation to perform +- `args`: method-specific arguments + +### Response Format + +Success: +``` +(id :ok result) +``` + +Error: +``` +(id :error "error message") +``` + +Server push (unsolicited): +``` +(:push type payload) +``` + +## Methods + +### eval + +Evaluate a Scheme expression string. Returns the result and captured stdout. + +``` +Request: (1 eval "(+ 1 2)") +Response: (1 :ok (:value "3" :stdout "")) + +Request: (2 eval "(begin (display 42) 99)") +Response: (2 :ok (:value "99" :stdout "42")) + +Request: (3 eval "(/ 1 0)") +Response: (3 :error "undefined for ~s") +``` + +### eval-region + +Evaluate multiple forms. Returns the value of the last form. + +``` +Request: (1 eval-region "(define x 10) (+ x 5)") +Response: (1 :ok (:value "15" :stdout "")) +``` + +### complete + +Return symbol completions for a prefix. + +``` +Request: (1 complete "string-") +Response: (1 :ok ("string-append" "string-length" "string-ref" ...)) +``` + +### doc + +Look up documentation for a symbol. + +``` +Request: (1 doc car) +Response: (1 :ok "(car pair) -> any\n Return the first element of pair.") +``` + +### apropos + +Search for symbols matching a substring. Returns list of (name type) pairs. + +``` +Request: (1 apropos "hash") +Response: (1 :ok (("hashtable-ref" "Procedure") ("hashtable-set!" "Procedure") ...)) +``` + +### expand + +Full macro expansion. + +``` +Request: (1 expand "(and 1 2)") +Response: (1 :ok "(if 1 2 #f)\n") +``` + +### expand1 + +One-step macro expansion (uses Chez's `sc-expand`). + +``` +Request: (1 expand1 "(and 1 2)") +Response: (1 :ok "...") +``` + +### type + +Get the type string for an expression's value. + +``` +Request: (1 type "42") +Response: (1 :ok "Fixnum") + +Request: (2 type "'(1 2 3)") +Response: (2 :ok "List[3]") +``` + +### describe + +Get a detailed description of an expression's value. + +``` +Request: (1 describe "(make-hashtable equal-hash equal?)") +Response: (1 :ok "HashTable[0]: #<hashtable>\n") +``` + +### import + +Import a module into the REPL environment. + +``` +Request: (1 import "(std text json)") +Response: (1 :ok "imported") +``` + +### load + +Load and evaluate a file. + +``` +Request: (1 load "/path/to/file.ss") +Response: (1 :ok "loaded /path/to/file.ss") +``` + +### env + +List environment symbols, optionally filtered by pattern. + +``` +Request: (1 env "cons") +Response: (1 :ok ("cons" "cons*")) + +Request: (2 env) +Response: (2 :ok ("..." ...)) ; up to 200 symbols +``` + +### pwd + +Get current working directory. + +``` +Request: (1 pwd) +Response: (1 :ok "/home/user/project") +``` + +### cd + +Change working directory. + +``` +Request: (1 cd "/tmp") +Response: (1 :ok "/tmp") +``` + +### ping + +Health check. + +``` +Request: (1 ping) +Response: (1 :ok "pong") +``` + +### shutdown + +Stop the server. + +``` +Request: (1 shutdown) +Response: (1 :ok "shutting down") +``` + +## Type Strings + +The `type` method returns human-readable type strings: + +| Type | Example | +|------|---------| +| `Boolean` | `#t`, `#f` | +| `Fixnum` | `42` | +| `Flonum` | `3.14` | +| `Bignum` | `99999999999999999` | +| `Rational` | `3/4` | +| `Complex` | `1+2i` | +| `Char` | `#\a` | +| `String[N]` | `"hello"` → `String[5]` | +| `Symbol` | `'foo` | +| `Keyword` | `':key` | +| `Null` | `'()` | +| `List[N]` | `'(1 2 3)` → `List[3]` | +| `AList[N]` | `'((a . 1) (b . 2))` → `AList[2]` | +| `Pair` | `'(1 . 2)` | +| `Vector[N]` | `#(a b c)` → `Vector[3]` | +| `Bytevector[N]` | `#vu8(1 2 3)` → `Bytevector[3]` | +| `HashTable[N]` | hash table with N entries | +| `Procedure` | any procedure | +| `Void` | `(void)` | +| `InputPort` | input ports | +| `OutputPort` | output ports | +| `InputOutputPort` | bidirectional ports | +| Record type name | e.g., `point` for `(defstruct point ...)` | + +## Emacs Integration Example + +```elisp +(defun jerboa-eval (expr) + "Evaluate EXPR in the Jerboa REPL server." + (let* ((port (jerboa-discover-port)) + (proc (open-network-stream "jerboa" nil "127.0.0.1" port)) + (id (cl-incf jerboa--request-id)) + (request (format "(%d eval %S)" id expr))) + (process-send-string proc request) + (process-send-string proc "\n") + ;; Read response... + )) + +(defun jerboa-discover-port () + "Read the server port from ~/.jerboa-repl-port." + (with-temp-buffer + (insert-file-contents "~/.jerboa-repl-port") + (when (re-search-forward "PORT=\\([0-9]+\\)" nil t) + (string-to-number (match-string 1))))) +``` + +## Implementation Notes + +- The server binds to `0.0.0.0` (all interfaces). For security, consider binding to `127.0.0.1` only in production. +- Each client connection runs in its own Chez thread. +- The server shares the `interaction-environment` — state changes from one client are visible to others. +- Stdout is captured per-eval via `parameterize` on `current-output-port`. +- The server auto-writes `~/.jerboa-repl-port` on start and removes it on stop. new file mode 100644 --- /dev/null +++ b/lib/std/repl/middleware.sls @@ -0,0 +1,195 @@ +#!chezscheme +;;; (std repl middleware) -- Extensible REPL Middleware System +;;; +;;; Allows users to extend the REPL with: +;;; - Custom commands (register-repl-command!) +;;; - Custom printers (register-repl-printer!) +;;; - Input transformers (register-input-transformer!) +;;; - Eval hooks (register-eval-hook!) +;;; +;;; Commands are dispatched by name (,mycommand args). +;;; Printers are tried in order for non-standard value types. +;;; Input transformers can rewrite expressions before eval. +;;; Eval hooks run before/after each evaluation. +;;; +;;; Usage: +;;; (import (std repl middleware)) +;;; +;;; ;; Register a custom command +;;; (register-repl-command! "greet" +;;; "Say hello" +;;; (lambda (args env cfg) +;;; (display "Hello, ") +;;; (display args) +;;; (newline))) +;;; +;;; ;; Register a custom printer for your record type +;;; (register-repl-printer! +;;; (lambda (val port) +;;; (and (my-record? val) +;;; (begin (display "#<my-record ...>" port) #t)))) +;;; +;;; ;; Register an input transformer +;;; (register-input-transformer! +;;; (lambda (str) +;;; ;; Transform !cmd to (shell "cmd") +;;; (if (and (> (string-length str) 0) +;;; (char=? (string-ref str 0) #\!)) +;;; (string-append "(system \"" (substring str 1 (string-length str)) "\")") +;;; str))) + +(library (std repl middleware) + (export + ;; Command registration + register-repl-command! + unregister-repl-command! + repl-command-registered? + list-repl-commands + dispatch-custom-command + + ;; Printer registration + register-repl-printer! + try-custom-printers + + ;; Input transformers + register-input-transformer! + apply-input-transformers + + ;; Eval hooks + register-eval-hook! + run-pre-eval-hooks + run-post-eval-hooks + + ;; Startup hooks + register-startup-hook! + run-startup-hooks + + ;; Prompt customization + register-prompt-fn! + compute-custom-prompt) + + (import (chezscheme)) + + ;; ========== Custom Commands ========== + ;; Each entry: (name doc-string handler) + ;; handler: (lambda (args-string env cfg) ...) + + (define *custom-commands* '()) + + (define (register-repl-command! name doc handler) + (let ([existing (assoc name *custom-commands*)]) + (if existing + ;; Replace + (set! *custom-commands* + (cons (list name doc handler) + (filter (lambda (e) (not (string=? (car e) name))) + *custom-commands*))) + (set! *custom-commands* + (cons (list name doc handler) *custom-commands*))))) + + (define (unregister-repl-command! name) + (set! *custom-commands* + (filter (lambda (e) (not (string=? (car e) name))) + *custom-commands*))) + + (define (repl-command-registered? name) + (and (assoc name *custom-commands*) #t)) + + (define (list-repl-commands) + ;; Returns list of (name . doc-string) pairs + (map (lambda (e) (cons (car e) (cadr e))) *custom-commands*)) + + (define (dispatch-custom-command name args env cfg) + (let ([entry (assoc name *custom-commands*)]) + (if entry + (begin ((caddr entry) args env cfg) #t) + #f))) + + ;; assoc from (chezscheme) uses equal? which handles strings + + ;; ========== Custom Printers ========== + ;; Each printer: (lambda (val port) -> #t if handled, #f if not) + + (define *custom-printers* '()) + + (define (register-repl-printer! printer) + (set! *custom-printers* (cons printer *custom-printers*))) + + (define (try-custom-printers val port) + ;; Try each printer in order. Returns #t if one handled it. + (let loop ([printers *custom-printers*]) + (cond + [(null? printers) #f] + [(guard (exn [#t #f]) + ((car printers) val port)) + #t] + [else (loop (cdr printers))]))) + + ;; ========== Input Transformers ========== + ;; Each transformer: (lambda (str) -> str) + + (define *input-transformers* '()) + + (define (register-input-transformer! transformer) + (set! *input-transformers* (cons transformer *input-transformers*))) + + (define (apply-input-transformers str) + ;; Apply all transformers in registration order (reversed since we cons) + (let loop ([transformers (reverse *input-transformers*)] [s str]) + (if (null? transformers) + s + (loop (cdr transformers) + (guard (exn [#t s]) + ((car transformers) s)))))) + + ;; ========== Eval Hooks ========== + ;; pre-eval: (lambda (expr-string env) -> void) + ;; post-eval: (lambda (expr-string result env) -> void) + + (define *pre-eval-hooks* '()) + (define *post-eval-hooks* '()) + + (define (register-eval-hook! type hook) + (case type + [(pre) (set! *pre-eval-hooks* (cons hook *pre-eval-hooks*))] + [(post) (set! *post-eval-hooks* (cons hook *post-eval-hooks*))] + [else (error 'register-eval-hook! "type must be 'pre or 'post" type)])) + + (define (run-pre-eval-hooks expr-str env) + (for-each (lambda (h) + (guard (exn [#t (void)]) + (h expr-str env))) + *pre-eval-hooks*)) + + (define (run-post-eval-hooks expr-str result env) + (for-each (lambda (h) + (guard (exn [#t (void)]) + (h expr-str result env))) + *post-eval-hooks*)) + + ;; ========== Startup Hooks ========== + (define *startup-hooks* '()) + + (define (register-startup-hook! hook) + (set! *startup-hooks* (cons hook *startup-hooks*))) + + (define (run-startup-hooks env cfg) + (for-each (lambda (h) + (guard (exn [#t (void)]) + (h env cfg))) + (reverse *startup-hooks*))) + + ;; ========== Prompt Customization ========== + (define *prompt-fn* #f) + + (define (register-prompt-fn! fn) + ;; fn: (lambda (env cfg) -> string) + (set! *prompt-fn* fn)) + + (define (compute-custom-prompt env cfg) + (if *prompt-fn* + (guard (exn [#t #f]) + (*prompt-fn* env cfg)) + #f)) + +) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/repl/notebook.sls @@ -0,0 +1,332 @@ +#!chezscheme +;;; (std repl notebook) -- Literate REPL Sessions +;;; +;;; Save and replay REPL sessions as executable Scheme files with +;;; markdown documentation. Like Jupyter notebooks for Scheme. +;;; +;;; File format (.ss.nb): +;;; ;; # Title +;;; ;; Description in markdown +;;; +;;; ;;; --- cell --- +;;; ;; Markdown documentation for this cell +;;; (define x 42) +;;; ;;; => 42 +;;; ;;; type: Fixnum +;;; +;;; Commands: +;;; (notebook-save path entries) — save entries to file +;;; (notebook-load path) — load entries from file +;;; (notebook-run path env) — execute all cells +;;; (notebook-export-html path) — export to HTML +;;; +;;; REPL integration (via ,notebook commands): +;;; ,notebook new title — start recording a new notebook +;;; ,notebook add — add current cell (last input/output) +;;; ,notebook note text — add a markdown note +;;; ,notebook save path — save notebook to file +;;; ,notebook show — display current notebook +;;; ,notebook run path — run a notebook file +;;; ,notebook stop — stop recording + +(library (std repl notebook) + (export + ;; Notebook record + make-notebook + notebook? + notebook-title + notebook-cells + + ;; Cell record + make-cell + cell? + cell-type ; 'code or 'markdown + cell-content ; string + cell-output ; string or #f (for code cells) + + ;; Operations + notebook-add-cell! + notebook-save + notebook-load + notebook-run + notebook-export-markdown + notebook-export-html + + ;; REPL session recording + *current-notebook* + notebook-recording? + notebook-start! + notebook-stop!) + + (import (chezscheme)) + + ;; ========== Cell Record ========== + (define-record-type cell + (fields (immutable type cell-type) ;; 'code or 'markdown + (immutable content cell-content) ;; string: source or markdown text + (immutable output cell-output)) ;; string or #f + (protocol (lambda (new) + (lambda (type content output) + (new type content output))))) + + ;; ========== Notebook Record ========== + (define-record-type notebook + (fields (immutable title notebook-title) + (mutable cells notebook-cells set-notebook-cells!)) + (protocol (lambda (new) + (lambda (title) + (new title '()))))) + + ;; ========== Session State ========== + (define *current-notebook* (make-parameter #f)) + + (define (notebook-recording?) + (and (*current-notebook*) #t)) + + (define (notebook-start! title) + (*current-notebook* (make-notebook title))) + + (define (notebook-stop!) + (let ([nb (*current-notebook*)]) + (*current-notebook* #f) + nb)) + + ;; ========== Cell Operations ========== + (define (notebook-add-cell! nb cell) + (set-notebook-cells! nb (append (notebook-cells nb) (list cell)))) + + ;; ========== Save to File ========== + (define (notebook-save path nb) + (call-with-output-file path + (lambda (port) + ;; Header + (fprintf port ";;; Jerboa Notebook: ~a~n" (notebook-title nb)) + (fprintf port ";;; Generated: ~a~n" (date-and-time)) + (newline port) + + ;; Cells + (for-each + (lambda (c) + (fprintf port ";;; --- cell ---~n") + (case (cell-type c) + [(markdown) + (for-each (lambda (line) + (fprintf port ";; ~a~n" line)) + (string-split-lines (cell-content c)))] + [(code) + (display (cell-content c) port) + (newline port) + (when (cell-output c) + (for-each (lambda (line) + (fprintf port ";;; => ~a~n" line)) + (string-split-lines (cell-output c))))]) + (newline port)) + (notebook-cells nb))) + 'replace)) + + ;; ========== Load from File ========== + (define (notebook-load path) + ;; Two-pass: first read all lines, then parse into cells + (let* ([lines (call-with-input-file path + (lambda (port) + (let loop ([acc '()]) + (let ([line (get-line port)]) + (if (eof-object? line) + (reverse acc) + (loop (cons line acc)))))))] + [title "Untitled"] + [cells '()]) + + ;; Extract title + (for-each (lambda (line) + (when (string-starts-with? line ";;; Jerboa Notebook: ") + (set! title (substring line 21 (string-length line))))) + lines) + + ;; Split into cell groups by ";;; --- cell ---" separator + (let ([groups (split-by-separator lines ";;; --- cell ---")]) + (for-each + (lambda (group) + ;; Classify cell: all lines start with ;; => markdown, else code + (let* ([content-lines (filter (lambda (l) + (and (not (string=? (string-trim* l) "")) + (not (string-starts-with? l ";;; =>")) + (not (string-starts-with? l ";;; Jerboa")) + (not (string-starts-with? l ";;; Generated")))) + group)] + [output-lines (filter-map + (lambda (l) + (and (string-starts-with? l ";;; => ") + (substring l 7 (string-length l)))) + group)]) + (when (pair? content-lines) + (let ([is-markdown (every-string-starts-with? content-lines ";; ")]) + (if is-markdown + (set! cells + (append cells + (list (make-cell 'markdown + (string-join-lines + (map (lambda (l) + (if (>= (string-length l) 3) + (substring l 3 (string-length l)) + "")) + content-lines)) + #f)))) + (set! cells + (append cells + (list (make-cell 'code + (string-join-lines content-lines) + (if (null? output-lines) #f + (string-join-lines output-lines))))))))))) + groups)) + + (let ([nb (make-notebook title)]) + (set-notebook-cells! nb cells) + nb))) + + (define (split-by-separator lines sep) + (let loop ([lines lines] [current '()] [groups '()]) + (cond + [(null? lines) + (reverse (if (null? current) groups (cons (reverse current) groups)))] + [(string=? (string-trim* (car lines)) sep) + (loop (cdr lines) '() + (if (null? current) groups (cons (reverse current) groups)))] + [else + (loop (cdr lines) (cons (car lines) current) groups)]))) + + (define (every-string-starts-with? lst prefix) + (or (null? lst) + (and (string-starts-with? (car lst) prefix) + (every-string-starts-with? (cdr lst) prefix)))) + + (define (filter-map proc lst) + (let loop ([l lst] [acc '()]) + (if (null? l) (reverse acc) + (let ([result (proc (car l))]) + (loop (cdr l) (if result (cons result acc) acc)))))) + ;; ========== Run a Notebook ========== + (define (notebook-run path env) + (let ([nb (notebook-load path)]) + (display (format "Running notebook: ~a (~a cells)\n" + (notebook-title nb) (length (notebook-cells nb)))) + (let loop ([cells (notebook-cells nb)] [results '()]) + (if (null? cells) + (reverse results) + (let ([c (car cells)]) + (case (cell-type c) + [(markdown) + (display (format "## ~a\n" (cell-content c))) + (loop (cdr cells) results)] + [(code) + (display (format "> ~a\n" (cell-content c))) + (guard (exn [#t + (display (format "ERROR: ~a\n" + (if (message-condition? exn) + (condition-message exn) + exn))) + (loop (cdr cells) (cons 'error results))]) + (let ([result (eval (with-input-from-string (cell-content c) read) env)]) + (unless (eq? result (void)) + (display (format "=> ~s\n" result))) + (loop (cdr cells) (cons result results))))])))))) + + ;; ========== Export to Markdown ========== + (define (notebook-export-markdown nb) + (with-output-to-string + (lambda () + (fprintf (current-output-port) "# ~a\n\n" (notebook-title nb)) + (for-each + (lambda (c) + (case (cell-type c) + [(markdown) + (display (cell-content c)) + (display "\n\n")] + [(code) + (display "```scheme\n") + (display (cell-content c)) + (display "\n```\n") + (when (cell-output c) + (display "```\n") + (display (cell-output c)) + (display "\n```\n")) + (newline)])) + (notebook-cells nb))))) + + ;; ========== Export to HTML ========== + (define (notebook-export-html nb) + (with-output-to-string + (lambda () + (display "<!DOCTYPE html>\n<html><head>\n") + (display "<meta charset=\"utf-8\">\n") + (fprintf (current-output-port) "<title>~a</title>\n" (html-escape (notebook-title nb))) + (display "<style>\n") + (display "body { font-family: -apple-system, sans-serif; max-width: 800px; margin: 40px auto; padding: 0 20px; }\n") + (display "pre { background: #f6f8fa; padding: 16px; border-radius: 6px; overflow-x: auto; }\n") + (display ".code { border-left: 3px solid #0366d6; }\n") + (display ".output { border-left: 3px solid #28a745; background: #f0fff0; }\n") + (display "h1, h2, h3 { color: #24292e; }\n") + (display "</style>\n</head><body>\n") + (fprintf (current-output-port) "<h1>~a</h1>\n" (html-escape (notebook-title nb))) + + (for-each + (lambda (c) + (case (cell-type c) + [(markdown) + (fprintf (current-output-port) "<p>~a</p>\n" (html-escape (cell-content c)))] + [(code) + (fprintf (current-output-port) "<pre class=\"code\"><code>~a</code></pre>\n" + (html-escape (cell-content c))) + (when (cell-output c) + (fprintf (current-output-port) "<pre class=\"output\"><code>~a</code></pre>\n" + (html-escape (cell-output c))))])) + (notebook-cells nb)) + + (display "</body></html>\n")))) + + ;; ========== Helpers ========== + (define (string-split-lines str) + (let ([len (string-length str)]) + (let loop ([i 0] [start 0] [acc '()]) + (cond + [(= i len) + (reverse (cons (substring str start len) acc))] + [(char=? (string-ref str i) #\newline) + (loop (+ i 1) (+ i 1) + (cons (substring str start i) acc))] + [else (loop (+ i 1) start acc)])))) + + (define (string-join-lines lines) + (if (null? lines) "" + (let loop ([rest (cdr lines)] [acc (car lines)]) + (if (null? rest) acc + (loop (cdr rest) (string-append acc "\n" (car rest))))))) + + (define (string-starts-with? str prefix) + (and (>= (string-length str) (string-length prefix)) + (string=? (substring str 0 (string-length prefix)) prefix))) + + (define (string-trim* str) + (let* ([n (string-length str)] + [s (let loop ([i 0]) + (if (or (= i n) (not (char-whitespace? (string-ref str i)))) i + (loop (+ i 1))))] + [e (let loop ([i (- n 1)]) + (if (or (< i 0) (not (char-whitespace? (string-ref str i)))) (+ i 1) + (loop (- i 1))))]) + (if (>= s e) "" (substring str s e)))) + + (define (html-escape str) + (let ([out (open-output-string)]) + (string-for-each + (lambda (c) + (cond + [(char=? c #\<) (display "<" out)] + [(char=? c #\>) (display ">" out)] + [(char=? c #\&) (display "&" out)] + [(char=? c #\") (display """ out)] + [else (display c out)])) + str) + (get-output-string out))) + +) ;; end library --- a/lib/std/repl/server.sls +++ b/lib/std/repl/server.sls @@ -284,6 +284,63 @@ [(shutdown) `(,id :ok "shutting down")] + ;; ---- IDE Integration Methods ---- + + [(threads) + ;; List active threads (Chez doesn't expose thread-list easily) + `(,id :ok (:note "thread listing not available in stock Chez"))] + + [(memory) + ;; GC and memory stats + (let* ([before (bytes-allocated)] + [_ (collect (collect-maximum-generation))] + [after (bytes-allocated)]) + `(,id :ok (:bytes-before ,before + :bytes-after ,after + :freed ,(- before after) + :max-generation ,(collect-maximum-generation))))] + + [(modules) + ;; List available libraries + (let ([libs (map (lambda (l) (format "~s" l)) + (library-list))]) + `(,id :ok ,libs))] + + [(find-source) + ;; Try to find info for a symbol + (let* ([sym (if (symbol? (car args)) (car args) + (string->symbol (car args)))] + [val (guard (e [#t #f]) (eval sym *server-env*))]) + (if (and val (procedure? val)) + (let ([name (guard (e [#t #f]) + (#%$code-name (#%$closure-code val)))]) + `(,id :ok (:name ,(if name (format "~a" name) (format "~a" sym)) + :type "Procedure"))) + `(,id :ok (:name ,(format "~a" sym) + :type ,(if val (value->type-string val) "unbound")))))] + + [(set-directory) + (current-directory (car args)) + `(,id :ok ,(current-directory))] + + [(list-directory) + (let* ([path (if (null? args) (current-directory) (car args))] + [entries (sort string<? (directory-list path))] + [result (map (lambda (e) + (let ([full (string-append path "/" e)]) + (list e (if (file-directory? full) "dir" "file")))) + entries)]) + `(,id :ok ,result))] + + [(interrupt) + ;; Placeholder for interrupt support + `(,id :ok "interrupt not yet implemented")] + + [(version) + `(,id :ok (:scheme ,(scheme-version) + :jerboa "1.0" + :protocol "1.0"))] + [else `(,id :error ,(format "unknown method: ~a" method))])))) --- a/tests/test-repl-enhanced.ss +++ b/tests/test-repl-enhanced.ss @@ -186,6 +186,82 @@ (lambda () (repl-pp '(a b c (d e f)))))]) (check-true (> (string-length out) 0))) +;; ========== Middleware ========== +(printf " Middleware...~n") +(import (std repl middleware)) + +;; Custom command registration +(register-repl-command! "test-cmd" "A test command" + (lambda (args env cfg) + (display (string-append "test:" args)))) + +(check-true (repl-command-registered? "test-cmd")) +(check-false (repl-command-registered? "nonexistent")) + +;; Dispatch +(let ([out (with-output-to-string + (lambda () (dispatch-custom-command "test-cmd" "hello" #f #f)))]) + (check out => "test:hello")) + +;; List commands +(let ([cmds (list-repl-commands)]) + (check-true (> (length cmds) 0))) + +;; Input transformer +(register-input-transformer! + (lambda (s) + (if (string=? s "MAGIC") "(+ 40 2)" s))) + +(check (apply-input-transformers "MAGIC") => "(+ 40 2)") +(check (apply-input-transformers "normal") => "normal") + +;; Eval hooks +(define *hook-log* '()) +(register-eval-hook! 'pre + (lambda (expr env) + (set! *hook-log* (cons (list 'pre expr) *hook-log*)))) + +(run-pre-eval-hooks "test" #f) +(check-true (= (length *hook-log*) 1)) + +;; ========== Notebook ========== +(printf " Notebook...~n") +(import (std repl notebook)) + +;; Create and save +(define test-nb (make-notebook "Test NB")) +(notebook-add-cell! test-nb (make-cell 'markdown "Hello world" #f)) +(notebook-add-cell! test-nb (make-cell 'code "(+ 1 2)" "3")) + +(check (notebook-title test-nb) => "Test NB") +(check (length (notebook-cells test-nb)) => 2) +(check (cell-type (car (notebook-cells test-nb))) => 'markdown) +(check (cell-type (cadr (notebook-cells test-nb))) => 'code) +(check (cell-output (cadr (notebook-cells test-nb))) => "3") + +;; Save and reload +(notebook-save "/tmp/test-jerboa-nb.ss.nb" test-nb) +(define loaded-nb (notebook-load "/tmp/test-jerboa-nb.ss.nb")) +(check (notebook-title loaded-nb) => "Test NB") +(check (length (notebook-cells loaded-nb)) => 2) + +;; Export markdown +(let ([md (notebook-export-markdown test-nb)]) + (check-true (string-contains* md "Test NB")) + (check-true (string-contains* md "```scheme"))) + +;; Export HTML +(let ([html (notebook-export-html test-nb)]) + (check-true (string-contains* html "<html>")) + (check-true (string-contains* html "Test NB"))) + +;; Recording +(notebook-start! "Recording") +(check-true (notebook-recording?)) +(let ([nb (notebook-stop!)]) + (check (notebook-title nb) => "Recording")) +(check-false (notebook-recording?)) + ;; ========== Summary ========== (printf "~n--- Results: ~a passed, ~a failed ---~n" pass-count fail-count) (when (> fail-count 0) (exit 1)) --- a/tests/test-repl-server.ss +++ b/tests/test-repl-server.ss @@ -39,16 +39,24 @@ ;; ========== Helpers ========== (define (nc-request port msg) - ;; Send a message via nc and get response - (let-values ([(to-stdin from-stdout from-stderr pid) - (open-process-ports - (format "echo '~a' | nc -q 1 127.0.0.1 ~a 2>/dev/null" msg port) - 'line (native-transcoder))]) - (close-port to-stdin) - (let ([response (get-line from-stdout)]) - (close-port from-stdout) - (close-port from-stderr) - (if (eof-object? response) "" response)))) + ;; Send a message via nc and get response, with retry on empty + (define (try-once) + (let-values ([(to-stdin from-stdout from-stderr pid) + (open-process-ports + (format "echo '~a' | nc -w 2 -q 2 127.0.0.1 ~a 2>/dev/null" msg port) + 'line (native-transcoder))]) + (close-port to-stdin) + (let ([response (get-line from-stdout)]) + (close-port from-stdout) + (close-port from-stderr) + (if (eof-object? response) "" response)))) + ;; Try up to 2 times + (let ([r (try-once)]) + (if (string=? r "") + (begin + (sleep (make-time 'time-duration 200000000 0)) + (try-once)) + r))) (printf "--- Testing (std repl server) ---~n")