anil.recoil.org
OCaml bindings to the Typesense embeddings search API
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6open Cmdliner
7
8let app_name = "typesense"
9
10(* Styled output helpers *)
11let header_style = Fmt.(styled `Bold string)
12let label_style = Fmt.(styled `Faint string)
13let value_style = Fmt.(styled (`Fg `Cyan) string)
14let success_style = Fmt.(styled (`Fg `Green) string)
15let warning_style = Fmt.(styled (`Fg `Yellow) string)
16let error_style = Fmt.(styled (`Fg `Red) string)
17let profile_style = Fmt.(styled (`Fg `Magenta) string)
18let current_style = Fmt.(styled (`Fg `Green) (styled `Bold string))
19
20(* Common Arguments *)
21
22let server_arg =
23 let doc = "Typesense server URL." in
24 let env = Cmd.Env.info "TYPESENSE_SERVER" ~doc in
25 Arg.(required & pos 0 (some string) None & info [] ~env ~docv:"SERVER" ~doc)
26
27let server_opt =
28 let doc = "Typesense server URL." in
29 let env = Cmd.Env.info "TYPESENSE_SERVER" ~doc in
30 Arg.(value & opt (some string) None & info ["server"; "s"] ~env ~docv:"URL" ~doc)
31
32let api_key_arg =
33 let doc = "API key (will prompt if not provided)." in
34 let env = Cmd.Env.info "TYPESENSE_API_KEY" ~doc in
35 Arg.(value & opt (some string) None & info ["api-key"; "k"] ~env ~docv:"KEY" ~doc)
36
37let profile_arg =
38 let doc = "Profile name (default: current profile)." in
39 Arg.(value & opt (some string) None & info ["profile"; "P"] ~docv:"PROFILE" ~doc)
40
41(* Logging setup - takes requests_config to extract verbose_http *)
42
43let setup_logging_with_config style_renderer level (requests_config : Requests.Cmd.config) =
44 Fmt_tty.setup_std_outputs ?style_renderer ();
45 Logs.set_level level;
46 Logs.set_reporter (Logs_fmt.reporter ());
47 Requests.Cmd.setup_log_sources ~verbose_http:requests_config.verbose_http.value level
48
49let setup_logging_simple style_renderer level =
50 Fmt_tty.setup_std_outputs ?style_renderer ();
51 Logs.set_level level;
52 Logs.set_reporter (Logs_fmt.reporter ())
53
54let setup_logging =
55 Term.(const (fun style_renderer level -> (style_renderer, level))
56 $ Fmt_cli.style_renderer ()
57 $ Logs_cli.level ())
58
59(* Requests config term *)
60
61let requests_config_term fs =
62 Requests.Cmd.config_term app_name fs
63
64(* Session helper *)
65
66let with_session ?profile f env =
67 let fs = env#fs in
68 match Session.load fs ?profile () with
69 | None ->
70 let profile_name =
71 match profile with
72 | Some p -> p
73 | None -> Session.get_current_profile fs
74 in
75 Fmt.epr "%a Not logged in (profile: %a). Use '%a' first.@."
76 error_style "Error:"
77 profile_style profile_name
78 Fmt.(styled `Bold string) "typesense-cli auth login";
79 raise (Error.Exit_code 1)
80 | Some session -> f fs session
81
82let with_client ?requests_config ?profile f env =
83 with_session ?profile (fun fs session ->
84 Eio.Switch.run @@ fun sw ->
85 let client = Client.resume ~sw ~env ?requests_config ?profile ~session () in
86 f fs client
87 ) env
88
89(* Profile configuration for external programs *)
90
91module Profile_config = struct
92 type t = {
93 style_renderer : Fmt.style_renderer option;
94 log_level : Logs.level option;
95 requests_config : Requests.Cmd.config;
96 profile : string option;
97 }
98
99 let style_renderer t = t.style_renderer
100 let log_level t = t.log_level
101 let requests_config t = t.requests_config
102 let profile t = t.profile
103
104 let setup_logging t =
105 setup_logging_with_config t.style_renderer t.log_level t.requests_config
106end
107
108let profile_config_term fs =
109 let make (sr, ll) rc p =
110 Profile_config.{ style_renderer = sr; log_level = ll; requests_config = rc; profile = p }
111 in
112 Term.(const make $ setup_logging $ requests_config_term fs $ profile_arg)
113
114(* Login command *)
115
116let login_action ~requests_config ~server ~api_key ~profile env =
117 let api_key = match api_key with
118 | Some k -> k
119 | None ->
120 Fmt.pr "%a @?" label_style "API Key:";
121 read_line ()
122 in
123 Eio.Switch.run @@ fun sw ->
124 let client = Client.login ~sw ~env ~requests_config ?profile ~server_url:server ~api_key () in
125 let profile_name = Option.value ~default:Session.default_profile profile in
126 Fmt.pr "%a Logged in to %a (profile: %a)@."
127 success_style "Success:" value_style server profile_style profile_name;
128 ignore client
129
130let login_cmd env fs =
131 let doc = "Login to a Typesense server." in
132 let info = Cmd.info "login" ~doc in
133 let login' (style_renderer, level) requests_config server api_key profile =
134 setup_logging_with_config style_renderer level requests_config;
135 Error.wrap (fun () ->
136 login_action ~requests_config ~server ~api_key ~profile env)
137 in
138 Cmd.v info
139 Term.(const login' $ setup_logging $ requests_config_term fs $ server_arg $ api_key_arg $ profile_arg)
140
141(* Logout command *)
142
143let logout_action ~profile env =
144 let fs = env#fs in
145 match Session.load fs ?profile () with
146 | None -> Fmt.pr "%a Not logged in.@." warning_style "Note:"
147 | Some session ->
148 Session.clear fs ?profile ();
149 let profile_name =
150 match profile with
151 | Some p -> p
152 | None -> Session.get_current_profile fs
153 in
154 Fmt.pr "%a Logged out from %a (profile: %a).@."
155 success_style "Success:"
156 value_style (Session.server_url session)
157 profile_style profile_name
158
159let logout_cmd env =
160 let doc = "Logout and clear saved session." in
161 let info = Cmd.info "logout" ~doc in
162 let logout' (style_renderer, level) profile =
163 setup_logging_simple style_renderer level;
164 logout_action ~profile env
165 in
166 Cmd.v info Term.(const logout' $ setup_logging $ profile_arg)
167
168(* Status command *)
169
170let status_action ~profile env =
171 let fs = env#fs in
172 let home = Sys.getenv "HOME" in
173 Fmt.pr "%a %a@." label_style "Config directory:" value_style (home ^ "/.config/typesense");
174 let current = Session.get_current_profile fs in
175 Fmt.pr "%a %a@." label_style "Current profile:" current_style current;
176 let profiles = Session.list_profiles fs in
177 if profiles <> [] then begin
178 Fmt.pr "%a %a@." label_style "Available profiles:"
179 Fmt.(list ~sep:(any ", ") profile_style) profiles
180 end;
181 Fmt.pr "@.";
182 let profile = Option.value ~default:current profile in
183 match Session.load fs ~profile () with
184 | None ->
185 Fmt.pr "%a %a: %a@."
186 header_style "Profile"
187 profile_style profile
188 warning_style "Not logged in"
189 | Some session ->
190 Fmt.pr "%a %a:@." header_style "Profile" profile_style profile;
191 Fmt.pr " %a@." Session.pp session
192
193let auth_status_cmd env =
194 let doc = "Show authentication status." in
195 let info = Cmd.info "status" ~doc in
196 let status' (style_renderer, level) profile =
197 setup_logging_simple style_renderer level;
198 status_action ~profile env
199 in
200 Cmd.v info Term.(const status' $ setup_logging $ profile_arg)
201
202(* Profile list command *)
203
204let profile_list_action env =
205 let fs = env#fs in
206 let current = Session.get_current_profile fs in
207 let profiles = Session.list_profiles fs in
208 if profiles = [] then
209 Fmt.pr "%a No profiles found. Use '%a' to create one.@."
210 warning_style "Note:"
211 Fmt.(styled `Bold string) "typesense-cli auth login"
212 else begin
213 Fmt.pr "%a@." header_style "Profiles:";
214 List.iter
215 (fun p ->
216 let is_current = p = current in
217 match Session.load fs ~profile:p () with
218 | Some session ->
219 if is_current then
220 Fmt.pr " %a %a - %a@."
221 current_style p
222 success_style "(current)"
223 value_style (Session.server_url session)
224 else
225 Fmt.pr " %a - %a@."
226 profile_style p
227 value_style (Session.server_url session)
228 | None ->
229 if is_current then
230 Fmt.pr " %a %a@." current_style p success_style "(current)"
231 else
232 Fmt.pr " %a@." profile_style p)
233 profiles
234 end
235
236let profile_list_cmd env =
237 let doc = "List available profiles." in
238 let info = Cmd.info "list" ~doc in
239 let list' (style_renderer, level) () =
240 setup_logging_simple style_renderer level;
241 profile_list_action env
242 in
243 Cmd.v info Term.(const list' $ setup_logging $ const ())
244
245(* Profile switch command *)
246
247let profile_name_arg =
248 let doc = "Profile name to switch to." in
249 Arg.(required & pos 0 (some string) None & info [] ~docv:"PROFILE" ~doc)
250
251let profile_switch_action ~profile env =
252 let fs = env#fs in
253 let profiles = Session.list_profiles fs in
254 if List.mem profile profiles then begin
255 Session.set_current_profile fs profile;
256 Fmt.pr "%a Switched to profile: %a@."
257 success_style "Success:"
258 profile_style profile
259 end
260 else begin
261 Fmt.epr "%a Profile '%a' not found.@."
262 error_style "Error:"
263 profile_style profile;
264 if profiles <> [] then
265 Fmt.epr "%a %a@."
266 label_style "Available profiles:"
267 Fmt.(list ~sep:(any ", ") profile_style) profiles;
268 raise (Error.Exit_code 1)
269 end
270
271let profile_switch_cmd env =
272 let doc = "Switch to a different profile." in
273 let info = Cmd.info "switch" ~doc in
274 let switch' (style_renderer, level) profile =
275 setup_logging_simple style_renderer level;
276 profile_switch_action ~profile env
277 in
278 Cmd.v info Term.(const switch' $ setup_logging $ profile_name_arg)
279
280(* Profile current command *)
281
282let profile_current_action env =
283 let fs = env#fs in
284 let current = Session.get_current_profile fs in
285 Fmt.pr "%a@." current_style current
286
287let profile_current_cmd env =
288 let doc = "Show current profile name." in
289 let info = Cmd.info "current" ~doc in
290 let current' (style_renderer, level) () =
291 setup_logging_simple style_renderer level;
292 profile_current_action env
293 in
294 Cmd.v info Term.(const current' $ setup_logging $ const ())
295
296(* Profile command group *)
297
298let profile_cmd env =
299 let doc = "Profile management commands." in
300 let info = Cmd.info "profile" ~doc in
301 Cmd.group info
302 [ profile_list_cmd env
303 ; profile_switch_cmd env
304 ; profile_current_cmd env
305 ]
306
307(* Auth command group *)
308
309let auth_cmd env fs =
310 let doc = "Authentication commands." in
311 let info = Cmd.info "auth" ~doc in
312 Cmd.group info
313 [ login_cmd env fs
314 ; logout_cmd env
315 ; auth_status_cmd env
316 ; profile_cmd env
317 ]