Recover JSON-in-batch tool calls from DeepSeek
ober
95fc444fb4736bfc3175d3ae7e108b8e8e439974
--- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -602,14 +602,74 @@ Be concise. Prefer edit over write for modifying existing files. (next (vector-ref tag 3))) (cond ((equal? name "batch") - (loop next - (append (reverse (xml-collect-tool-calls body)) acc))) + ;; Try JSON-in-batch shape first ({tools:[{name,arguments}]} + ;; or {calls:[...]} or a bare array). Fall back to nested + ;; XML tags if no JSON structure is recognised. + (let ((from-json (batch-body->tool-calls body))) + (loop next + (append (reverse (if (not (null? from-json)) + from-json + (xml-collect-tool-calls body))) + acc)))) ((tool-exists? name) (loop next (cons (make-tool-call name (xml->json-args attrs body)) acc))) (else (loop next acc))))))))))))) +(def (batch-body->tool-calls body) + ;; Recognise <batch>{json}</batch> shapes that some models emit instead of + ;; nested tags. Accepts: + ;; {"tools":[{"name":"x","arguments":{}}, ...]} + ;; {"calls":[{"tool":"x","args":{}}, ...]} + ;; [{"name":"x","arguments":{}}, ...] + ;; Tolerates leading/trailing whitespace and ```json fences. + (let* ((stripped (xml-strip-code-fence (string-trim body))) + (parsed (guard (e [#t #f]) (string->json-object stripped)))) + (cond + ((not parsed) '()) + ((hash-table? parsed) + (let ((arr (or (hash-get parsed "tools") + (hash-get parsed "calls") + (hash-get parsed "tool_calls")))) + (if (list? arr) + (filter-map json-entry->tool-call arr) + '()))) + ((list? parsed) (filter-map json-entry->tool-call parsed)) + (else '())))) + +(def (json-entry->tool-call obj) + (and (hash-table? obj) + (let ((name (or (hash-get obj "name") + (hash-get obj "tool") + (hash-get obj "function"))) + (args (or (hash-get obj "arguments") + (hash-get obj "args") + (hash-get obj "input") + (make-hash-table)))) + (and (string? name) + (tool-exists? name) + (make-tool-call name + (cond + ((string? args) args) + ((hash-table? args) (json-object->string args)) + (else "{}"))))))) + +(def (xml-strip-code-fence s) + ;; Strip ```json ... ``` or ``` ... ``` wrappers. + (let ((len (string-length s))) + (cond + ((< len 6) s) + ((and (char=? (string-ref s 0) #\`) + (char=? (string-ref s 1) #\`) + (char=? (string-ref s 2) #\`)) + (let* ((nl (xml-find-from s "\n" 3 len)) + (inner-start (if nl (+ nl 1) 3)) + (close (xml-find-from s "```" inner-start len)) + (inner-end (or close len))) + (substring s inner-start inner-end))) + (else s)))) + (def (xml-find-lt text start end) (let loop ((i start)) (cond