Something went wrong. Try again.
Provider-neutral LLM requests, transcripts and responses, I/O-free
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230(*--------------------------------------------------------------------------- Copyright (c) 2026 Invariant Systems. All rights reserved. SPDX-License-Identifier: ISC ---------------------------------------------------------------------------*)
open Importmodule String_set = Set.Make (String)module String_map = Map.Make (String)
let invalid fn message = invalid_arg' "Llm.Transcript" fn message
(* Pending tool calls are tracked incrementally: [start_pending] records the calls of an assistant message and [answer_result] folds each result into [answered], so appending a message never rescans the whole message list. *)type pending = { calls : Tool.Call.t list; expected_names : string String_map.t; answered : String_set.t;}
type t = { rev_messages : Message.t list; pending : pending option }
module Error = struct type t = | Tool_result_without_call of Tool.Result.t | Unknown_tool_result of { call_id : string } | Duplicate_tool_result of { call_id : string } | Tool_result_name_mismatch of { call_id : string; expected : string; actual : string; } | Duplicate_tool_call of { call_id : string } | Pending_tool_results of Tool.Call.t list
let message = function | Tool_result_without_call result -> "tool result without preceding assistant tool call: " ^ Tool.Result.call_id result | Unknown_tool_result { call_id } -> "tool result names unknown call_id: " ^ call_id | Duplicate_tool_result { call_id } -> "duplicate tool result: " ^ call_id | Tool_result_name_mismatch { call_id; expected; actual } -> "tool result name does not match call_id " ^ call_id ^ ": expected " ^ expected ^ ", got " ^ actual | Duplicate_tool_call { call_id } -> "duplicate tool call: " ^ call_id | Pending_tool_results calls -> let ids = List.map Tool.Call.id calls |> String.concat ", " in "assistant tool calls are missing tool results: " ^ ids
let pp ppf error = Fmt.string ppf (message error)end
open Error
type state = Ready | Awaiting_tool_results of Tool.Call.t * Tool.Call.t list
let empty = { rev_messages = []; pending = None }let is_empty t = match t.rev_messages with [] -> true | _ :: _ -> falselet messages t = List.rev t.rev_messageslet length t = List.length t.rev_messages
let unanswered pending = List.filter (fun call -> not (String_set.mem (Tool.Call.id call) pending.answered)) pending.calls
let pending_calls = function None -> [] | Some pending -> unanswered pendinglet pending t = pending_calls t.pending
let state t = match pending t with | [] -> Ready | call :: calls -> Awaiting_tool_results (call, calls)
let is_ready t = match state t with Ready -> true | Awaiting_tool_results _ -> false
let require_ready t = match state t with | Ready -> Ok () | Awaiting_tool_results (call, calls) -> Error (Pending_tool_results (call :: calls))
let expected_map calls = List.fold_left (fun map call -> String_map.add (Tool.Call.id call) (Tool.Call.name call) map) String_map.empty calls
let call_ids_unique calls = let rec loop seen = function | [] -> Ok () | call :: rest -> let call_id = Tool.Call.id call in if String_set.mem call_id seen then Error (Duplicate_tool_call { call_id }) else loop (String_set.add call_id seen) rest in loop String_set.empty calls
let start_pending assistant = match Message.Assistant.tool_calls assistant with | [] -> Ok None | calls -> ( match call_ids_unique calls with | Error _ as error -> error | Ok () -> Ok (Some { calls; expected_names = expected_map calls; answered = String_set.empty; }))
let pending_is_complete pending = match unanswered pending with [] -> true | _ -> false
let close_pending = function | None -> Ok () | Some pending -> ( match unanswered pending with | [] -> Ok () | missing -> Error (Pending_tool_results missing))
let answer_result result pending = let call_id = Tool.Result.call_id result in match String_map.find_opt call_id pending.expected_names with | None -> Error (Unknown_tool_result { call_id }) | Some expected_name -> if String_set.mem call_id pending.answered then Error (Duplicate_tool_result { call_id }) else let actual = Tool.Result.name result in if not (String.equal expected_name actual) then Error (Tool_result_name_mismatch { call_id; expected = expected_name; actual }) else let pending = { pending with answered = String_set.add call_id pending.answered } in if pending_is_complete pending then Ok None else Ok (Some pending)
let push message pending t = Ok { rev_messages = message :: t.rev_messages; pending }
let add message t = match message with | Message.Tool_result result -> ( match t.pending with | None -> Error (Tool_result_without_call result) | Some pending -> ( match answer_result result pending with | Error _ as error -> error | Ok pending -> push message pending t)) | Message.System _ | Message.Developer _ | Message.User _ -> ( match close_pending t.pending with | Error _ as error -> error | Ok () -> push message None t) | Message.Assistant assistant -> ( match close_pending t.pending with | Error _ as error -> error | Ok () -> ( match start_pending assistant with | Error _ as error -> error | Ok pending -> push message pending t))
let of_list messages = let rec loop t = function | [] -> Ok t | message :: rest -> ( match add message t with | Error _ as error -> error | Ok t -> loop t rest) in loop empty messages
let raise_error fn error = invalid fn (Error.message error)
let of_list_exn messages = match of_list messages with | Ok t -> t | Error error -> raise_error "of_list_exn" error
let add_exn message t = match add message t with | Ok t -> t | Error error -> raise_error "add_exn" error
let add_response response t = add (Response.message response) t
let last_assistant t = let rec loop = function | [] -> None | Message.Assistant assistant :: _ -> Some assistant | ( Message.System _ | Message.Developer _ | Message.User _ | Message.Tool_result _ ) :: rest -> loop rest in loop t.rev_messages
let last_assistant_text ?(sep = "") t = let rec loop = function | [] -> None | Message.Assistant assistant :: rest -> ( match Message.Assistant.texts assistant with | [] -> loop rest | texts -> Some (String.concat sep texts)) | ( Message.System _ | Message.Developer _ | Message.User _ | Message.Tool_result _ ) :: rest -> loop rest in loop t.rev_messages
let jsont = let v messages = match of_list messages with | Ok transcript -> transcript | Error error -> decode_error (Error.message error) in Json.Codec.Object.map ~kind:"LLM transcript" v |> Json.Codec.Object.member "messages" (Json.Codec.list Message.jsont) ~enc:messages |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal