Add markdown rendering for streamed output
ober
0f7a053436b38ed5d8538adfb391edae56173707
--- a/lib/jcode/ui/cli.sls +++ b/lib/jcode/ui/cli.sls @@ -211,27 +211,129 @@ [#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 stream-token] + (md-reset!) + (parameterize ([current-stream-cb md-stream-token] [current-tool-cb tool-indicator]) (agent-run session-id input)) - (printf "~n~n") + (md-flush!) (printf "~n~n") (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) (printf "~nError: ~a~n" (format-error e))))) (def (one-shot-mode prompt opts) - (try (parameterize ([current-stream-cb stream-token] + (try (md-reset!) + (parameterize ([current-stream-cb md-stream-token] [current-tool-cb tool-indicator]) (agent-chat prompt)) - (newline) + (md-flush!) (newline) (catch (e) (log-error logger "error" `((msg . ,(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 *md-line-buf* "") + (def *md-in-code-block* #f) + (def *backtick* (integer->char 96)) + (def (md-reset!) + (set! *md-line-buf* "") + (set! *md-in-code-block* #f)) + (def (md-stream-token token) + (set! *md-line-buf* (string-append *md-line-buf* token)) + (let flush-lines () + (let ([idx (string-contains *md-line-buf* "\n")]) + (when idx + (let ([line (substring *md-line-buf* 0 idx)] + [rest (substring + *md-line-buf* + (+ idx 1) + (string-length *md-line-buf*))]) + (md-render-line line) + (newline) + (flush-output-port (current-output-port)) + (set! *md-line-buf* rest) + (flush-lines)))))) + (def (md-flush!) + (when (> (string-length *md-line-buf*) 0) + (md-render-line *md-line-buf*) + (flush-output-port (current-output-port)) + (set! *md-line-buf* ""))) + (def (md-render-line line) + (let ([fence (string-append + (string *backtick*) + (string *backtick*) + (string *backtick*))]) + (cond + [(string-prefix? fence line) + (set! *md-in-code-block* (not *md-in-code-block*)) + (if *md-in-code-block* + (let ([lang (string-trim + (substring line 3 (string-length line)))]) + (when (> (string-length lang) 0) + (printf "\x1B;[2m--- ~a ---\x1B;[0m" lang))) + (display "\x1B;[2m----------\x1B;[0m"))] + [*md-in-code-block* (printf "\x1B;[32m~a\x1B;[0m" line)] + [(string-prefix? "### " line) + (printf + "\x1B;[1;33m~a\x1B;[0m" + (substring line 4 (string-length line)))] + [(string-prefix? "## " line) + (printf + "\x1B;[1;33m~a\x1B;[0m" + (substring line 3 (string-length line)))] + [(string-prefix? "# " line) + (printf + "\x1B;[1;33m~a\x1B;[0m" + (substring line 2 (string-length line)))] + [#t (display (md-inline line))]))) + (def (md-inline text) + (let ([len (string-length text)]) + (let loop ([i 0] [out '()]) + (cond + [(>= i len) (apply string-append (reverse out))] + [(and (< (+ i 1) len) + (char=? (string-ref text i) #\*) + (char=? (string-ref text (+ i 1)) #\*)) + (let ([end (find-marker text (+ i 2) "**")]) + (if end + (loop + (+ end 2) + (cons + "\x1B;[0m" + (cons + (substring text (+ i 2) end) + (cons "\x1B;[1m" out)))) + (loop (+ i 1) (cons "*" out))))] + [(char=? (string-ref text i) *backtick*) + (let ([end (find-char text (+ i 1) *backtick*)]) + (if end + (loop + (+ end 1) + (cons + "\x1B;[0m" + (cons + (substring text (+ i 1) end) + (cons "\x1B;[36m" out)))) + (loop (+ i 1) (cons (string *backtick*) out))))] + [#t + (loop (+ i 1) (cons (string (string-ref text i)) out))])))) + (def (find-marker text start marker) + (let ([len (string-length text)] + [m0 (string-ref marker 0)] + [m1 (string-ref marker 1)]) + (let loop ([i start]) + (cond + [(>= (+ i 1) len) #f] + [(and (char=? (string-ref text i) m0) + (char=? (string-ref text (+ i 1)) m1)) + i] + [#t (loop (+ i 1))])))) + (def (find-char text start ch) + (let ([len (string-length text)]) + (let loop ([i start]) + (cond + [(>= i len) #f] + [(char=? (string-ref text i) ch) i] + [#t (loop (+ i 1))])))) (def (tool-indicator event name args) (case event [(start) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -197,9 +197,11 @@ EXAMPLES: (try (printf "~n") (flush-output-port (current-output-port)) - (parameterize ((current-stream-cb stream-token) + (md-reset!) + (parameterize ((current-stream-cb md-stream-token) (current-tool-cb tool-indicator)) (agent-run session-id input)) + (md-flush!) (printf "~n~n") (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) @@ -207,18 +209,107 @@ EXAMPLES: (def (one-shot-mode prompt opts) (try - (parameterize ((current-stream-cb stream-token) + (md-reset!) + (parameterize ((current-stream-cb md-stream-token) (current-tool-cb tool-indicator)) (agent-chat prompt)) + (md-flush!) (newline) (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) (printf "Error: ~a~n" (format-error e)) (exit 1)))) -(def (stream-token token) - (display token) - (flush-output-port (current-output-port))) +;; --- line-buffered markdown renderer --- + +(def *md-line-buf* "") +(def *md-in-code-block* #f) +(def *backtick* (integer->char 96)) + +(def (md-reset!) + (set! *md-line-buf* "") + (set! *md-in-code-block* #f)) + +(def (md-stream-token token) + (set! *md-line-buf* (string-append *md-line-buf* token)) + (let flush-lines () + (let ((idx (string-contains *md-line-buf* "\n"))) + (when idx + (let ((line (substring *md-line-buf* 0 idx)) + (rest (substring *md-line-buf* (+ idx 1) (string-length *md-line-buf*)))) + (md-render-line line) + (newline) + (flush-output-port (current-output-port)) + (set! *md-line-buf* rest) + (flush-lines)))))) + +(def (md-flush!) + (when (> (string-length *md-line-buf*) 0) + (md-render-line *md-line-buf*) + (flush-output-port (current-output-port)) + (set! *md-line-buf* ""))) + +(def (md-render-line line) + (let ((fence (string-append (string *backtick*) (string *backtick*) (string *backtick*)))) + (cond + ((string-prefix? fence line) + (set! *md-in-code-block* (not *md-in-code-block*)) + (if *md-in-code-block* + (let ((lang (string-trim (substring line 3 (string-length line))))) + (when (> (string-length lang) 0) + (printf "\x1b;[2m--- ~a ---\x1b;[0m" lang))) + (display "\x1b;[2m----------\x1b;[0m"))) + (*md-in-code-block* + (printf "\x1b;[32m~a\x1b;[0m" line)) + ((string-prefix? "### " line) + (printf "\x1b;[1;33m~a\x1b;[0m" (substring line 4 (string-length line)))) + ((string-prefix? "## " line) + (printf "\x1b;[1;33m~a\x1b;[0m" (substring line 3 (string-length line)))) + ((string-prefix? "# " line) + (printf "\x1b;[1;33m~a\x1b;[0m" (substring line 2 (string-length line)))) + (#t (display (md-inline line)))))) + +(def (md-inline text) + (let ((len (string-length text))) + (let loop ((i 0) (out '())) + (cond + ((>= i len) + (apply string-append (reverse out))) + ((and (< (+ i 1) len) + (char=? (string-ref text i) #\*) + (char=? (string-ref text (+ i 1)) #\*)) + (let ((end (find-marker text (+ i 2) "**"))) + (if end + (loop (+ end 2) + (cons "\x1b;[0m" (cons (substring text (+ i 2) end) (cons "\x1b;[1m" out)))) + (loop (+ i 1) (cons "*" out))))) + ((char=? (string-ref text i) *backtick*) + (let ((end (find-char text (+ i 1) *backtick*))) + (if end + (loop (+ end 1) + (cons "\x1b;[0m" (cons (substring text (+ i 1) end) (cons "\x1b;[36m" out)))) + (loop (+ i 1) (cons (string *backtick*) out))))) + (#t + (loop (+ i 1) (cons (string (string-ref text i)) out))))))) + +(def (find-marker text start marker) + (let ((len (string-length text)) + (m0 (string-ref marker 0)) + (m1 (string-ref marker 1))) + (let loop ((i start)) + (cond + ((>= (+ i 1) len) #f) + ((and (char=? (string-ref text i) m0) + (char=? (string-ref text (+ i 1)) m1)) i) + (#t (loop (+ i 1))))))) + +(def (find-char text start ch) + (let ((len (string-length text))) + (let loop ((i start)) + (cond + ((>= i len) #f) + ((char=? (string-ref text i) ch) i) + (#t (loop (+ i 1))))))) (def (tool-indicator event name args) (case event