Something went wrong. Try again.
Provider-neutral LLM requests, transcripts and responses, I/O-free
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282(*--------------------------------------------------------------------------- Copyright (c) 2026 Invariant Systems. All rights reserved. SPDX-License-Identifier: ISC ---------------------------------------------------------------------------*)
open Import
let invalid fn message = invalid_arg' "Llm.Message" fn message
let reject_empty fn field value = if String.equal "" value then invalid fn (field ^ " must not be empty")
module Assistant = struct module Reasoning = struct type t = { id : string option; summary : string option; text : string option; encrypted : string option; signature : string option; }
let check_opt fn field = Option.iter (reject_empty fn field)
let v ?id ?summary ?text ?encrypted ?signature () = check_opt "Assistant.Reasoning.v" "id" id; check_opt "Assistant.Reasoning.v" "summary" summary; check_opt "Assistant.Reasoning.v" "text" text; check_opt "Assistant.Reasoning.v" "encrypted" encrypted; check_opt "Assistant.Reasoning.v" "signature" signature; begin match (id, summary, text, encrypted, signature) with | None, None, None, None, None -> invalid "Assistant.Reasoning.v" "at least one field is required" | _ -> () end; { id; summary; text; encrypted; signature }
let id t = t.id let summary t = t.summary let text t = t.text let encrypted t = t.encrypted let signature t = t.signature
let equal a b = let eq = Option.equal String.equal in eq a.id b.id && eq a.summary b.summary && eq a.text b.text && eq a.encrypted b.encrypted && eq a.signature b.signature
let jsont = let v id summary text encrypted signature = decode_invalid_arg (fun () -> v ?id ?summary ?text ?encrypted ?signature ()) in Json.Codec.Object.map ~kind:"assistant reasoning part" v |> Json.Codec.Object.opt_member "id" Json.Codec.string ~enc:id |> Json.Codec.Object.opt_member "summary" Json.Codec.string ~enc:summary |> Json.Codec.Object.opt_member "text" Json.Codec.string ~enc:text |> Json.Codec.Object.opt_member "encrypted" Json.Codec.string ~enc:encrypted |> Json.Codec.Object.opt_member "signature" Json.Codec.string ~enc:signature |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal end
type part = | Text of string | Tool_call of Tool.Call.t | Reasoning of Reasoning.t
let text_part value = reject_empty "Assistant.text_part" "text" value; Text value
let tool_call call = Tool_call call let reasoning_part reasoning = Reasoning reasoning
type t = { parts : part list }
let check_part = function | Text "" -> invalid "Assistant.v" "text part must not be empty" | Text _ | Tool_call _ | Reasoning _ -> ()
let empty = { parts = [] }
let v parts = begin match parts with | [] -> invalid "Assistant.v" "parts must not be empty" | _ -> () end; List.iter check_part parts; { parts }
let text value = v [ text_part value ] let parts t = t.parts
let tool_calls t = List.filter_map (function Tool_call call -> Some call | Text _ | Reasoning _ -> None) t.parts
let texts t = List.filter_map (function Text text -> Some text | Tool_call _ | Reasoning _ -> None) t.parts
let reasonings t = List.filter_map (function | Reasoning reasoning -> Some reasoning | Text _ | Tool_call _ -> None) t.parts
(* Tool-call parts embed unparsed JSON, so they compare through {!Tool.Call.equal}; text and reasoning parts carry only strings. *) let part_equal a b = match (a, b) with | Text a, Text b -> String.equal a b | Tool_call a, Tool_call b -> Tool.Call.equal a b | Reasoning a, Reasoning b -> Reasoning.equal a b | (Text _ | Tool_call _ | Reasoning _), _ -> false
let equal a b = List.equal part_equal a.parts b.parts
let part_jsont = let text = Json.Codec.Object.map ~kind:"assistant text part" (fun text -> decode_invalid_arg (fun () -> text_part text)) |> Json.Codec.Object.member "text" Json.Codec.string ~enc:(function | Text text -> text | Tool_call _ | Reasoning _ -> assert false) |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal |> Json.Codec.Object.Case.map "text" ~dec:Fun.id in let tool_call = Json.Codec.Object.map ~kind:"assistant tool-call part" tool_call |> Json.Codec.Object.member "tool_call" Tool.Call.jsont ~enc:(function | Tool_call call -> call | Text _ | Reasoning _ -> assert false) |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal |> Json.Codec.Object.Case.map "tool_call" ~dec:Fun.id in let reasoning = Json.Codec.Object.map ~kind:"assistant reasoning part" reasoning_part |> Json.Codec.Object.member "reasoning" Reasoning.jsont ~enc:(function | Reasoning reasoning -> reasoning | Text _ | Tool_call _ -> assert false) |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal |> Json.Codec.Object.Case.map "reasoning" ~dec:Fun.id in let cases = List.map Json.Codec.Object.Case.v [ text; tool_call; reasoning ] in let enc_case = function | Text _ as part -> Json.Codec.Object.Case.value text part | Tool_call _ as part -> Json.Codec.Object.Case.value tool_call part | Reasoning _ as part -> Json.Codec.Object.Case.value reasoning part in Json.Codec.Object.map ~kind:"assistant part" Fun.id |> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:Fun.id ~enc_case cases |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal
let jsont = let of_parts = function [] -> empty | parts -> v parts in let v parts = decode_invalid_arg (fun () -> of_parts parts) in Json.Codec.Object.map ~kind:"assistant message" v |> Json.Codec.Object.member "parts" (Json.Codec.list part_jsont) ~enc:parts |> Json.Codec.Object.error_unknown |> Json.Codec.Object.sealend
type t = | System of string | Developer of string | User of Content.t list | Assistant of Assistant.t | Tool_result of Tool.Result.t
let system value = reject_empty "system" "text" value; System value
let developer value = reject_empty "developer" "text" value; Developer value
let user content = match content with | [] -> invalid "user" "content must not be empty" | _ -> User content
let user_text value = user [ Content.text value ]let assistant value = Assistant valuelet assistant_text value = assistant (Assistant.text value)let tool_result value = Tool_result value
(* Structural over payload, semantic over embedded tool-call JSON: only the assistant case can carry unparsed JSON, and it defers to {!Assistant.equal}; the other cases hold strings, content, and results free of source metadata. *)let equal a b = match (a, b) with | System a, System b | Developer a, Developer b -> String.equal a b | User a, User b -> List.equal Content.equal a b | Assistant a, Assistant b -> Assistant.equal a b | Tool_result a, Tool_result b -> Tool.Result.equal a b | (System _ | Developer _ | User _ | Assistant _ | Tool_result _), _ -> false
let pp ppf = function | System text -> Fmt.pf ppf "system %S" text | Developer text -> Fmt.pf ppf "developer %S" text | User content -> Fmt.pf ppf "user %a" Fmt.(list ~sep:(any " ") Content.pp) content | Assistant a -> Fmt.pf ppf "assistant, %d parts" (List.length (Assistant.parts a)) | Tool_result r -> Fmt.pf ppf "tool result %s %s" (Tool.Result.call_id r) (Tool.Result.name r)
let text_case ~kind ~tag make project = Json.Codec.Object.map ~kind (fun text -> decode_invalid_arg (fun () -> make text)) |> Json.Codec.Object.member "text" Json.Codec.string ~enc:project |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal |> Json.Codec.Object.Case.map tag ~dec:Fun.id
let system_case = text_case ~kind:"system message" ~tag:"system" system (function | System text -> text | Developer _ | User _ | Assistant _ | Tool_result _ -> assert false)
let developer_case = text_case ~kind:"developer message" ~tag:"developer" developer (function | Developer text -> text | System _ | User _ | Assistant _ | Tool_result _ -> assert false)
let user_case = Json.Codec.Object.map ~kind:"user message" (fun content -> decode_invalid_arg (fun () -> user content)) |> Json.Codec.Object.member "content" (Json.Codec.list Content.jsont) ~enc:(function | User content -> content | System _ | Developer _ | Assistant _ | Tool_result _ -> assert false) |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal |> Json.Codec.Object.Case.map "user" ~dec:Fun.id
let assistant_case = Json.Codec.Object.map ~kind:"assistant message" assistant |> Json.Codec.Object.member "assistant" Assistant.jsont ~enc:(function | Assistant assistant -> assistant | System _ | Developer _ | User _ | Tool_result _ -> assert false) |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal |> Json.Codec.Object.Case.map "assistant" ~dec:Fun.id
let tool_result_case = Json.Codec.Object.map ~kind:"tool-result message" tool_result |> Json.Codec.Object.member "tool_result" Tool.Result.jsont ~enc:(function | Tool_result result -> result | System _ | Developer _ | User _ | Assistant _ -> assert false) |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal |> Json.Codec.Object.Case.map "tool_result" ~dec:Fun.id
let jsont = let system = system_case and developer = developer_case and user = user_case and assistant = assistant_case and tool_result = tool_result_case in let cases = List.map Json.Codec.Object.Case.v [ system; developer; user; assistant; tool_result ] in let enc_case = function | System _ as message -> Json.Codec.Object.Case.value system message | Developer _ as message -> Json.Codec.Object.Case.value developer message | User _ as message -> Json.Codec.Object.Case.value user message | Assistant _ as message -> Json.Codec.Object.Case.value assistant message | Tool_result _ as message -> Json.Codec.Object.Case.value tool_result message in Json.Codec.Object.map ~kind:"message" Fun.id |> Json.Codec.Object.case_member "role" Json.Codec.string ~enc:Fun.id ~enc_case cases |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal