Source file provider_options.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
(** Type-safe heterogeneous key-value store using extensible GADTs.

    Uses {!Obj.Extension_constructor.id} to identify keys at runtime and
    {!Obj.magic} for type recovery. This is type-safe by construction:
    two extensible variant constructors share the same [Extension_constructor.id]
    if and only if they are the same constructor, which guarantees they carry
    the same type parameter. This is the standard OCaml pattern for extensible
    GADTs, used by {!Printexc} and other stdlib modules.

    Future: OCaml 5.1+ [Type.eq] would provide a first-class type equality
    witness, eliminating the need for [Obj.magic]. *)

type _ key = ..

type entry = Entry : 'a key * 'a -> entry

type t = entry list

let empty = []

let set (type a) (k : a key) (v : a) (opts : t) : t =
  let kid = Obj.Extension_constructor.id (Obj.Extension_constructor.of_val k) in
  let replaced = ref false in
  let opts' =
    List.filter_map
      (fun (Entry (k', _) as e) ->
        let kid' = Obj.Extension_constructor.id (Obj.Extension_constructor.of_val k') in
        if Int.equal kid kid' then begin
          replaced := true;
          Some (Entry (k, v))
        end
        else Some e)
      opts
  in
  if !replaced then opts' else Entry (k, v) :: opts

(* NOTE on Obj.magic: This is the standard pattern for extensible GADT
   existentials in OCaml. When two extensible variant constructors have the
   same Extension_constructor.id, they are the same constructor and thus
   carry the same type parameter. The Obj.magic is therefore type-safe.
   This is the same approach used by Printexc and other stdlib modules. *)
let find (type a) (k : a key) (opts : t) : a option =
  let kid = Obj.Extension_constructor.id (Obj.Extension_constructor.of_val k) in
  let rec go = function
    | [] -> None
    | Entry (k', v) :: rest ->
      let kid' = Obj.Extension_constructor.id (Obj.Extension_constructor.of_val k') in
      if Int.equal kid' kid then Some (Obj.magic v : a) else go rest
  in
  go opts

let find_exn k opts =
  match find k opts with
  | Some v -> v
  | None -> raise Not_found

(** Raw provider metadata from upstream re-submissions.
    Stores [Record<string, Record<string, JsonValue>>] — each provider
    reads its own namespace (e.g. ["anthropic"]). *)
type _ key += Provider_metadata : Yojson.Basic.t key

let of_provider_metadata json = set Provider_metadata json empty

let provider_metadata opts = find Provider_metadata opts