Source file anthropic_model.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
(** Check for unsupported features and emit warnings. *)
let check_unsupported ~anthropic_opts (opts : Ai_provider.Call_options.t) =
  List.concat
    [
      (match opts.frequency_penalty with
      | Some _ -> [ Ai_provider.Warning.Unsupported_feature { feature = "frequency_penalty"; details = None } ]
      | None -> []);
      (match opts.presence_penalty with
      | Some _ -> [ Ai_provider.Warning.Unsupported_feature { feature = "presence_penalty"; details = None } ]
      | None -> []);
      (match opts.seed with
      | Some _ -> [ Ai_provider.Warning.Unsupported_feature { feature = "seed"; details = None } ]
      | None -> []);
      (* Warn if thinking is enabled with temperature *)
      (match anthropic_opts.Anthropic_options.thinking with
      | Some t when t.Thinking.enabled && Option.is_some opts.temperature ->
        [
          Ai_provider.Warning.Unsupported_feature
            {
              feature = "temperature with thinking";
              details = Some "Anthropic does not support temperature when thinking is enabled";
            };
        ]
      | _ -> []);
    ]

(** Prepare the request body and warnings — shared by generate and stream. *)
let prepare_request ~model ~stream (opts : Ai_provider.Call_options.t) =
  let anthropic_opts =
    Anthropic_options.of_provider_options opts.provider_options
    |> Stdlib.Option.value ~default:Anthropic_options.default
  in
  let warnings = check_unsupported ~anthropic_opts opts in
  let system, remaining = Convert_prompt.extract_system opts.prompt in
  let messages = Convert_prompt.convert_messages remaining in
  (* Route Object_json per-model: native output_config where supported, synthetic [json]
     tool with forced tool_choice otherwise — matches upstream @ai-sdk/anthropic. *)
  let supports_native_structured_output =
    (Model_catalog.capabilities (Model_catalog.of_model_id model)).supports_structured_output
  in
  let output_config, fallback_tool, forced_tool_choice, extra_warnings =
    match opts.mode with
    | Regular | Object_tool _ -> None, None, None, []
    | Object_json (Some { name = _; schema }) when supports_native_structured_output ->
      Some Anthropic_api.{ format = { type_ = "json_schema"; schema } }, None, None, []
    | Object_json (Some { name = _; schema }) ->
      let tool = Convert_tools.json_response_tool ~schema in
      None, Some tool, Some Convert_tools.forced_json_tool_choice, []
    | Object_json None ->
      ( None,
        None,
        None,
        [
          Ai_provider.Warning.Unsupported_feature
            {
              feature = "response_format without schema";
              details = Some "Anthropic structured outputs require a JSON schema; sending request without enforcement";
            };
        ] )
  in
  let warnings = warnings @ extra_warnings in
  let base_tools, base_tool_choice = Convert_tools.convert_tools ~tools:opts.tools ~tool_choice:opts.tool_choice in
  let tools = Option.fold ~none:base_tools ~some:(fun t -> base_tools @ [ t ]) fallback_tool in
  (* When structured-output fallback is active, override the caller's tool_choice. *)
  let tool_choice =
    match forced_tool_choice with
    | Some _ -> forced_tool_choice
    | None -> base_tool_choice
  in
  (* Use model-aware default for max_tokens *)
  let max_tokens =
    Some
      (match opts.max_output_tokens with
      | Some n -> n
      | None -> Model_catalog.default_max_tokens (Model_catalog.of_model_id model))
  in
  let thinking_enabled =
    match anthropic_opts.thinking with
    | Some t when t.Thinking.enabled -> true
    | Some _ | None -> false
  in
  let body =
    Anthropic_api.make_request_body ~model ~messages ?system ~tools ?tool_choice ?max_tokens
      ?temperature:opts.temperature ?top_p:opts.top_p ?top_k:opts.top_k ~stop_sequences:opts.stop_sequences
      ?thinking:anthropic_opts.thinking ?output_config ~stream ()
  in
  (* Merge user headers with required beta headers — the result includes all of opts.headers
     plus a merged anthropic-beta header, so it replaces opts.headers entirely *)
  let required_betas =
    Beta_headers.required_betas ~thinking:thinking_enabled ~has_pdf:false ~tool_streaming:anthropic_opts.tool_streaming
  in
  let extra_headers = Beta_headers.merge_beta_headers ~user_headers:opts.headers ~required:required_betas in
  body, warnings, extra_headers

let create ~config ~model =
  let module M = struct
    let specification_version = "V3"
    let provider = "anthropic"
    let model_id = model

    let generate opts =
      let body, warnings, extra_headers = prepare_request ~model ~stream:false opts in
      match%lwt Anthropic_api.messages ~config ~body ~extra_headers ~stream:false with
      | `Json json ->
        let result = Convert_response.parse_response json in
        Lwt.return { result with warnings = warnings @ result.warnings }
      | `Stream _ -> Lwt.fail_with "unexpected streaming response for non-streaming request"

    let stream opts =
      let body, warnings, extra_headers = prepare_request ~model ~stream:true opts in
      match%lwt Anthropic_api.messages ~config ~body ~extra_headers ~stream:true with
      | `Stream line_stream ->
        let sse_events = Sse.parse_events line_stream in
        let parts = Convert_stream.transform sse_events ~warnings in
        Lwt.return { Ai_provider.Stream_result.stream = parts; warnings; raw_response = None }
      | `Json _ -> Lwt.fail_with "unexpected non-streaming response for streaming request"
  end in
  (module M : Ai_provider.Language_model.S)