Add export support and update search integration
ober
5dfd6e54aee6757ba56a5533e6599de184fac4df
--- a/src/llm-search/config.ss +++ b/src/llm-search/config.ss @@ -14,7 +14,7 @@ (def *config* (make-hash-table)) (def (set-defaults!) - (hash-put! *config* "db-path" (path-join (getenv "HOME") "llm.db")) + (hash-put! *config* "db-path" (path-join (getenv "HOME") ".llm-search" "llm.db")) (hash-put! *config* "socket-path" (path-join (getenv "HOME") ".llm-search" "server.sock")) (hash-put! *config* "index-interval" 300) (hash-put! *config* "page-size" 20) @@ -46,7 +46,7 @@ (hash-ref *config* key #f)) (def (config-db-path) - (or (config-get "db-path") (path-join (getenv "HOME") "llm.db"))) + (or (config-get "db-path") (path-join (getenv "HOME") ".llm-search" "llm.db"))) (def (config-socket-path) (or (config-get "socket-path") (path-join (getenv "HOME") ".llm-search" "server.sock"))) new file mode 100644 --- /dev/null +++ b/src/llm-search/export.ss @@ -0,0 +1,104 @@ +;;; llm-search/export.ss — Export sessions to Markdown + +(library (llm-search export) + (export export-session-markdown find-session-file) + (import (chezscheme) (jerboa prelude clean)) + + (def CODEX-BASE (path-join (getenv "HOME") ".codex" "sessions")) + + (def (find-session-file session-id) + (let ((found #f)) + (when (file-directory? CODEX-BASE) + (let loop ((d CODEX-BASE)) + (when (and (not found) (file-directory? d)) + (for-each (lambda (entry) + (let ((full (path-join d entry))) + (if (file-directory? full) + (loop full) + (when (and (string-suffix? ".jsonl" entry) + (string-contains entry session-id)) + (set! found full))))) + (directory-list d))))) + found)) + + (def (json-str v) + (cond ((string? v) v) + ((number? v) (number->string v)) + ((boolean? v) (if v "true" "false")) + (else ""))) + + (def (truncate-str s n) + (if (> (string-length s) n) + (string-append (substring s 0 n) "\n... (truncated)") + s)) + + (def (skip-system-text? text) + (or (string-prefix? "<permissions" text) + (string-prefix? "<collaboration" text) + (string-prefix? "<environment" text))) + + (def (export-session-markdown session-id) + (let ((file (find-session-file session-id))) + (unless file + (error 'export "session not found" session-id)) + (let* ((lines (read-file-lines file)) + (out (open-output-string)) + (turn 0)) + (for-each + (lambda (line) + (when (and line (not (string-empty? line))) + (let* ((obj (string->json-object line)) + (type (json-str (hash-get obj "type"))) + (payload (hash-get obj "payload"))) + (cond + ((string=? type "session_meta") + (format out "# Codex Session ~a\n\n" (json-str (hash-get payload "session_id"))) + (format out "- **Date**: ~a\n" (json-str (hash-get payload "timestamp"))) + (format out "- **CWD**: ~a\n" (json-str (hash-get payload "cwd"))) + (format out "- **Model**: ~a\n" (json-str (hash-get payload "model_provider"))) + (format out "- **CLI**: ~a\n\n---\n\n" (json-str (hash-get payload "cli_version")))) + ((and (string=? type "event_msg") + (string=? (json-str (hash-get payload "type")) "task_started")) + (set! turn (+ turn 1)) + (format out "\n## Turn ~a\n\n" turn)) + ((string=? type "response_item") + (let* ((role (hash-get payload "role")) + (item-type (json-str (hash-get payload "type")))) + (cond + ((and (string=? item-type "message") (equal? role "user")) + (let ((texts (filter-map + (lambda (c) + (when (and (hashtable? c) + (string=? (json-str (hash-get c "type")) "input_text")) + (hash-get c "text"))) + (or (hash-get payload "content") '())))) + (let ((body (string-join (filter (lambda (t) (and (string? t) (not (skip-system-text? t)))) texts) "\n"))) + (when (not (string-empty? (string-trim body))) + (format out "### User\n\n~a\n\n" (string-trim body)))))) + ((and (string=? item-type "message") (equal? role "assistant")) + (let ((texts (filter-map + (lambda (c) + (when (and (hashtable? c) + (string=? (json-str (hash-get c "type")) "output_text")) + (hash-get c "text"))) + (or (hash-get payload "content") '())))) + (let ((body (string-join (filter string? texts) "\n"))) + (when (not (string-empty? (string-trim body))) + (format out "### Assistant\n\n~a\n\n" (string-trim body)))))) + ((string=? item-type "function_call") + (let* ((name (json-str (hash-get payload "name"))) + (args-raw (json-str (hash-get payload "arguments"))) + (summary (try + (let* ((args (string->json-object args-raw))) + (cond ((hash-get args "command") => (lambda (c) (format #f "`~a`" (truncate-str c 200)))) + ((hash-get args "file_path") => (lambda (f) (format #f "`~a`" f))) + (else (format #f "`~a`" (truncate-str args-raw 200))))) + (catch (e) (format #f "`~a`" (truncate-str args-raw 200)))))) + (format out "> **Tool**: ~a — ~a\n\n" name summary))) + ((string=? item-type "function_call_output") + (let ((output (json-str (hash-get payload "output")))) + (when (not (string-empty? (string-trim output))) + (format out "<details><summary>output</summary>\n\n```\n~a\n```\n</details>\n\n" + (truncate-str (string-trim output) 500)))))))))))) + lines) + (get-output-string out))))) --- a/src/llm-search/main.ss +++ b/src/llm-search/main.ss @@ -2,7 +2,8 @@ (export main) (import (chezscheme) (jerboa prelude clean) (jsqlite api) (llm-search db) (llm-search sources) (llm-search search) - (llm-search server) (llm-search mcp) (llm-search config)) + (llm-search server) (llm-search mcp) (llm-search config) + (llm-search export)) (def DEFAULT-DB-PATH (config-db-path)) @@ -32,7 +33,16 @@ (displayln content))) matched) (sqlite-close db)))) ((string=? cmd "mcp") (mcp-server-start DEFAULT-DB-PATH)) + ((string=? cmd "export") + (if (< (length args) 2) + (displayln "Usage: llm-search export <session-id> [output-file]") + (let* ((session-id (cadr args)) + (md (export-session-markdown session-id)) + (out-file (if (>= (length args) 3) (caddr args) + (string-append "session-" (substring session-id 0 8) ".md")))) + (write-file-string out-file md) + (displayln "Exported to " out-file)))) (else (displayln "Unknown command: " cmd) - (displayln "Commands: serve, index, stats, search, mcp") + (displayln "Commands: serve, index, stats, search, export, mcp") (exit 1)))))) --- a/src/llm-search/mcp.ss +++ b/src/llm-search/mcp.ss @@ -138,6 +138,11 @@ (mcp-schema "object" (list (mcp-prop "source" "string" "Source name (optional, all if omitted)")) (list)) + "object") + (mcp-tool "llm_export" "Export a session to Markdown by session ID" + (mcp-schema "object" + (list (mcp-prop "session_id" "string" "External session ID (e.g. codex UUID)")) + (list "session_id")) "object"))) (def (tool-to-server-method tool-name) @@ -146,6 +151,7 @@ ((string=? tool-name "llm_get_session") "search_session") ((string=? tool-name "llm_stats") "stats") ((string=? tool-name "llm_index") "index") + ((string=? tool-name "llm_export") "export_session") (else tool-name))) (def (mcp-forward-tool-call params id) --- a/src/llm-search/protocol.ss +++ b/src/llm-search/protocol.ss @@ -13,7 +13,8 @@ (jsqlite api) (llm-search search) (llm-search db) - (llm-search sources)) + (llm-search sources) + (llm-search export)) ;; --- JSON-RPC message helpers --- @@ -114,6 +115,17 @@ [(string=? method "ping") (json-rpc-response "pong" id)] + [(string=? method "export_session") + (let* ((session-id (hash-get params "session_id"))) + (unless (string? session-id) + (return (json-rpc-error -32602 "Invalid params: session_id required" id))) + (try + (let* ((md (export-session-markdown session-id))) + (json-rpc-response (list (cons 'markdown md) (cons 'session_id session-id)) id)) + (catch (e) + (json-rpc-error -32000 + (with-output-to-string (lambda () (display-condition e (current-output-port)))) id))))] + [else (json-rpc-error -32601 "Method not found" id)])) --- a/src/llm-search/sources.ss +++ b/src/llm-search/sources.ss @@ -36,7 +36,7 @@ (session-line-insert! db session-id seq text-id role timestamp) (for-each (lambda (term) (let ((tid (term-ensure! db term))) (posting-insert! db tid text-id))) tokens))) (def (index-line-batch! db session-id lines) - (for-each (lambda (line idx) (index-line! db session-id idx (hash-get line "role") (hash-get line "content") (hash-get line "timestamp"))) lines (iota (length lines))) + (for-each (lambda (line idx) (index-line! db session-id idx (json-string (hash-get line "role")) (json-string (hash-get line "content")) (json-string (hash-get line "timestamp")))) lines (iota (length lines))) (session-update-line-count! db session-id (length lines))) (def (scan-codex-sessions) (if (file-directory? CODEX-BASE) @@ -71,7 +71,11 @@ (when (and item-type (string=? item-type "input_text")) (let ((text (hash-get item "text"))) (when (string? text) - (set! messages (cons (list (cons 'role (json-string role)) (cons 'content (json-string text)) (cons 'timestamp (json-string (hash-get obj "timestamp")))) messages)))))))))) + (let* ((msg-ht (make-hash-table))) + (hash-put! msg-ht "role" (json-string role)) + (hash-put! msg-ht "content" (json-string text)) + (hash-put! msg-ht "timestamp" (json-string (hash-get obj "timestamp"))) + (set! messages (cons msg-ht messages))))))))))) #f)))))))) (when (and session-id (not (string-empty? session-id))) (session-insert! db source-id session-id "" cwd model started-at) --- a/vendor/jerboa-sqlite/OPUS_4_8_CONTINUATION_HANDOFF.md +++ b/vendor/jerboa-sqlite/OPUS_4_8_CONTINUATION_HANDOFF.md @@ -27,7 +27,7 @@ The differential lane uses the sibling oracle checkout: The branch remote is: ```text -origin git@git.sr.ht:~lisp/jsqlite +origin https://git.jerboa.sh/ober/jerboa-sqlite ``` ## Major Work Completed Since The Previous Commit @@ -129,4 +129,3 @@ is intended to be committed together. git diff --check make test ``` - --- a/vendor/jerboa-sqlite/README.md +++ b/vendor/jerboa-sqlite/README.md @@ -99,7 +99,7 @@ docs/ ## Build & test -Requires [`jerbuild`](https://git.sr.ht/~lisp) on `PATH`. The differential lane +Requires [`jerbuild`](https://git.jerboa.sh/ober/jerboa) on `PATH`. The differential lane additionally requires the `../jerboa-sqlite` reference checkout (a C compiler + system `libsqlite3`); it is skipped if that checkout is absent.