anil.recoil.org
A monorepo management tool for the agentic ages
Refactor unpac-claude to use Claude SDK's MCP-based custom tool architecture
- Rewrite tools.ml to use Claude.Tool.create and Claude.Mcp_server
- Tools are now bundled into an in-process MCP server named "unpac"
- Custom tools accessible as mcp__unpac__<tool_name>
- Update agent.ml to register MCP server via Options.with_mcp_server
- Simplify handler: built-in tools handled by Claude CLI, custom tools via MCP
- Remove manual tool dispatch in on_tool_use handler
- Add on_tool_result handler for logging
This aligns with the Python Claude Agent SDK's approach where:
- Built-in tools (Read, Write, Bash, etc.) are handled by Claude CLI
- Custom tools are defined via MCP servers executed in-process
🤖 Generated with [Claude Code](https://claude.ai/code)
Co-Authored-By: Claude <noreply@anthropic.com>
+301
-314
lib/claude/agent.ml
+301
-314
lib/claude/agent.ml
···
1
-
(** Autonomous Claude agent for unpac workflows.
1
+
(** Ralph-loop style Claude agent for unpac workspace analysis.
2
2
3
-
This implementation supports two modes:
4
-
1. Interactive - REPL-style conversation with user input
5
-
2. Autonomous - Continuous analysis and improvement loop *)
3
+
Implements the ralph-loop pattern: same prompt fed each iteration,
4
+
with state persisting in files. Runs up to max_iterations per project,
5
+
exiting early on completion promise.
6
+
7
+
Uses the Claude SDK's MCP-based custom tool architecture. Custom unpac
8
+
tools are registered via an in-process MCP server, while Claude's built-in
9
+
tools (Read, Write, Bash, etc.) are handled by Claude CLI directly. *)
6
10
7
11
let src = Logs.Src.create "unpac.claude.agent" ~doc:"Claude agent"
8
12
module Log = (val Logs.src_log src : Logs.LOG)
9
13
14
+
(* ANSI color codes *)
15
+
module Color = struct
16
+
let reset = "\x1b[0m"
17
+
let bold = "\x1b[1m"
18
+
let dim = "\x1b[2m"
19
+
let red = "\x1b[31m"
20
+
let green = "\x1b[32m"
21
+
let yellow = "\x1b[33m"
22
+
let blue = "\x1b[34m"
23
+
let magenta = "\x1b[35m"
24
+
let cyan = "\x1b[36m"
25
+
end
26
+
10
27
type config = {
11
-
model : [ `Sonnet | `Opus | `Haiku ];
12
-
max_turns : int option;
13
28
verbose : bool;
14
-
autonomous : bool;
15
-
sync_interval : int; (* turns between unpac status/push *)
16
-
web_port : int option; (* port for web UI, None = disabled *)
29
+
web_port : int option;
30
+
max_iterations : int;
31
+
project : string option;
17
32
}
18
33
19
34
let default_config = {
20
-
model = `Sonnet;
21
-
max_turns = None;
22
35
verbose = false;
23
-
autonomous = false;
24
-
sync_interval = 10;
25
36
web_port = None;
37
+
max_iterations = 20;
38
+
project = None;
26
39
}
27
40
28
-
(* Rate limit state *)
29
-
type rate_limit_state = {
30
-
mutable consecutive_errors : int;
31
-
mutable backoff_until : float;
32
-
}
33
-
34
-
let create_rate_limit_state () = {
35
-
consecutive_errors = 0;
36
-
backoff_until = 0.0;
37
-
}
38
-
39
-
(* Calculate backoff time with exponential increase *)
40
-
let calculate_backoff state =
41
-
let base_delay = 5.0 in (* 5 seconds base *)
42
-
let max_delay = 300.0 in (* 5 minutes max *)
43
-
let delay = min max_delay (base_delay *. (2.0 ** float_of_int state.consecutive_errors)) in
44
-
delay
45
-
46
-
(* Check if we should wait due to rate limiting *)
47
-
let should_wait_for_rate_limit ~clock state =
48
-
let now = Eio.Time.now clock in
49
-
if now < state.backoff_until then begin
50
-
let wait_time = state.backoff_until -. now in
51
-
Log.info (fun m -> m "Rate limited, waiting %.1f seconds..." wait_time);
52
-
Some wait_time
53
-
end else
54
-
None
55
-
56
-
(* Record a rate limit error *)
57
-
let record_rate_limit_error ~clock state =
58
-
let now = Eio.Time.now clock in
59
-
state.consecutive_errors <- state.consecutive_errors + 1;
60
-
let delay = calculate_backoff state in
61
-
state.backoff_until <- now +. delay;
62
-
Log.warn (fun m -> m "Rate limit error #%d, backing off for %.1f seconds"
63
-
state.consecutive_errors delay);
64
-
delay
41
+
let completion_promise = "AGENTIC-HUMPS-COUNT-2"
65
42
66
-
(* Record successful request *)
67
-
let record_success state =
68
-
state.consecutive_errors <- 0
43
+
(* Format tool call for logging - full paths, no truncation *)
44
+
let format_tool_call name (input : Claude.Tool_input.t) =
45
+
let get_string key = Claude.Tool_input.get_string input key in
46
+
match name with
47
+
| "Read" ->
48
+
let path = get_string "file_path" |> Option.value ~default:"?" in
49
+
Printf.sprintf "Read %s" path
50
+
| "Write" ->
51
+
let path = get_string "file_path" |> Option.value ~default:"?" in
52
+
Printf.sprintf "Write %s" path
53
+
| "Edit" ->
54
+
let path = get_string "file_path" |> Option.value ~default:"?" in
55
+
Printf.sprintf "Edit %s" path
56
+
| "Bash" ->
57
+
let cmd = get_string "command" |> Option.value ~default:"?" in
58
+
Printf.sprintf "$ %s" cmd
59
+
| "Glob" ->
60
+
let pattern = get_string "pattern" |> Option.value ~default:"*" in
61
+
let path = get_string "path" |> Option.value ~default:"" in
62
+
if path = "" then Printf.sprintf "Glob %s" pattern
63
+
else Printf.sprintf "Glob %s in %s" pattern path
64
+
| "Grep" ->
65
+
let pattern = get_string "pattern" |> Option.value ~default:"?" in
66
+
let path = get_string "path" |> Option.value ~default:"" in
67
+
if path = "" then Printf.sprintf "Grep %s" pattern
68
+
else Printf.sprintf "Grep %s in %s" pattern path
69
+
(* MCP tools are prefixed with mcp__unpac__ *)
70
+
| s when String.length s > 12 && String.sub s 0 12 = "mcp__unpac__" ->
71
+
let tool_name = String.sub s 12 (String.length s - 12) in
72
+
(match tool_name with
73
+
| "read_file" ->
74
+
let path = get_string "path" |> Option.value ~default:"?" in
75
+
Printf.sprintf "unpac:read %s" path
76
+
| "write_file" ->
77
+
let path = get_string "path" |> Option.value ~default:"?" in
78
+
Printf.sprintf "unpac:write %s" path
79
+
| "list_directory" ->
80
+
let path = get_string "path" |> Option.value ~default:"." in
81
+
Printf.sprintf "unpac:ls %s" path
82
+
| "glob_files" ->
83
+
let pattern = get_string "pattern" |> Option.value ~default:"*" in
84
+
Printf.sprintf "unpac:glob %s" pattern
85
+
| "run_shell" ->
86
+
let cmd = get_string "command" |> Option.value ~default:"?" in
87
+
Printf.sprintf "unpac:$ %s" cmd
88
+
| "git_commit" ->
89
+
let msg = get_string "message" |> Option.value ~default:"" in
90
+
Printf.sprintf "unpac:commit %s" msg
91
+
| "unpac_status" -> "unpac:status"
92
+
| "unpac_status_sync" -> "unpac:status --sync"
93
+
| "unpac_push" ->
94
+
let remote = get_string "remote" |> Option.value ~default:"origin" in
95
+
Printf.sprintf "unpac:push %s" remote
96
+
| "unpac_project_list" -> "unpac:projects"
97
+
| "unpac_opam_list" -> "unpac:opam list"
98
+
| "unpac_git_list" -> "unpac:git list"
99
+
| "unpac_git_add" ->
100
+
let url = get_string "url" |> Option.value ~default:"?" in
101
+
Printf.sprintf "unpac:git add %s" url
102
+
| "unpac_git_info" ->
103
+
let n = get_string "name" |> Option.value ~default:"?" in
104
+
Printf.sprintf "unpac:git info %s" n
105
+
| "unpac_git_diff" ->
106
+
let n = get_string "name" |> Option.value ~default:"?" in
107
+
Printf.sprintf "unpac:git diff %s" n
108
+
| _ -> Printf.sprintf "unpac:%s" tool_name)
109
+
| _ -> name
69
110
70
111
(* Find unpac root from a given directory *)
71
112
let find_root_from fs dir =
···
84
125
in
85
126
search (Eio.Path.(fs / dir)) 0
86
127
87
-
(* Find unpac root from current directory *)
88
-
let find_root fs =
89
-
find_root_from fs (Sys.getcwd ())
90
-
91
-
(* Convert our model type to claude library model *)
92
-
let to_claude_model = function
93
-
| `Sonnet -> `Sonnet_4
94
-
| `Opus -> `Opus_4
95
-
| `Haiku -> `Haiku_4
96
-
97
-
(* Helper for substring checking *)
98
128
let string_contains ~sub s =
99
129
let len_sub = String.length sub in
100
130
let len_s = String.length s in
···
108
138
check 0
109
139
end
110
140
111
-
(* Simple JSON to string serialization *)
112
-
let rec json_to_string (json : Jsont.json) =
113
-
let escape_string s =
114
-
let buf = Buffer.create (String.length s + 16) in
115
-
Buffer.add_char buf '"';
116
-
String.iter (fun c ->
117
-
match c with
118
-
| '"' -> Buffer.add_string buf "\\\""
119
-
| '\\' -> Buffer.add_string buf "\\\\"
120
-
| '\n' -> Buffer.add_string buf "\\n"
121
-
| '\r' -> Buffer.add_string buf "\\r"
122
-
| '\t' -> Buffer.add_string buf "\\t"
123
-
| c when Char.code c < 32 ->
124
-
Buffer.add_string buf (Printf.sprintf "\\u%04x" (Char.code c))
125
-
| c -> Buffer.add_char buf c
126
-
) s;
127
-
Buffer.add_char buf '"';
128
-
Buffer.contents buf
129
-
in
130
-
match json with
131
-
| Jsont.Null _ -> "null"
132
-
| Jsont.Bool (b, _) -> if b then "true" else "false"
133
-
| Jsont.Number (n, _) ->
134
-
if Float.is_integer n then Printf.sprintf "%.0f" n
135
-
else Printf.sprintf "%g" n
136
-
| Jsont.String (s, _) -> escape_string s
137
-
| Jsont.Array (items, _) ->
138
-
"[" ^ String.concat "," (List.map json_to_string items) ^ "]"
139
-
| Jsont.Object (members, _) ->
140
-
let member_to_string ((key, _), value) =
141
-
escape_string key ^ ":" ^ json_to_string value
142
-
in
143
-
"{" ^ String.concat "," (List.map member_to_string members) ^ "}"
141
+
(* Shuffle a list randomly *)
142
+
let shuffle list =
143
+
let arr = Array.of_list list in
144
+
let n = Array.length arr in
145
+
for i = n - 1 downto 1 do
146
+
let j = Random.int (i + 1) in
147
+
let tmp = arr.(i) in
148
+
arr.(i) <- arr.(j);
149
+
arr.(j) <- tmp
150
+
done;
151
+
Array.to_list arr
144
152
145
-
let is_rate_limit_error msg =
146
-
let s = String.lowercase_ascii msg in
147
-
string_contains ~sub:"rate" s ||
148
-
string_contains ~sub:"429" s ||
149
-
string_contains ~sub:"limit" s ||
150
-
string_contains ~sub:"overloaded" s ||
151
-
string_contains ~sub:"quota" s
153
+
(* Ensure working directory exists *)
154
+
let ensure_work_dir fs root project =
155
+
let root_dir = snd root in
156
+
let work_base = Eio.Path.(fs / root_dir / ".unpac-claude") in
157
+
let work_dir = Eio.Path.(work_base / project) in
158
+
let claude_dir = Eio.Path.(work_dir / ".claude") in
159
+
(try Eio.Path.mkdir ~perm:0o755 work_base with _ -> ());
160
+
(try Eio.Path.mkdir ~perm:0o755 work_dir with _ -> ());
161
+
(try Eio.Path.mkdir ~perm:0o755 claude_dir with _ -> ());
162
+
work_dir
152
163
153
-
(* Run the agent *)
154
-
let run ~env ~config ~initial_prompt ?workspace_path () =
155
-
let fs = Eio.Stdenv.fs env in
164
+
(* Run ralph-loop for a single project *)
165
+
let run_project_ralph_loop ~env ~config ~root ~project ~event_bus =
156
166
let proc_mgr = Eio.Stdenv.process_mgr env in
157
-
let clock = Eio.Stdenv.clock env in
158
-
let net = Eio.Stdenv.net env in
159
-
160
-
(* Find unpac root *)
161
-
let root = match workspace_path with
162
-
| Some path ->
163
-
(match find_root_from fs path with
164
-
| Some r -> r
165
-
| None ->
166
-
Format.eprintf "Error: '%s' is not an unpac workspace.@." path;
167
-
exit 1)
168
-
| None ->
169
-
(match find_root fs with
170
-
| Some r -> r
171
-
| None ->
172
-
Format.eprintf "Error: Not in an unpac workspace.@.";
173
-
Format.eprintf "Run 'unpac init' to create one or specify --workspace.@.";
174
-
exit 1)
175
-
in
167
+
let fs = Eio.Stdenv.fs env in
176
168
177
-
Log.info (fun m -> m "Starting agent in workspace: %s" (snd root));
178
-
if config.autonomous then
179
-
Log.info (fun m -> m "Running in AUTONOMOUS mode");
169
+
let prefix = Printf.sprintf "[%s] " project in
170
+
let log msg = Log.info (fun m -> m "%s%s" prefix msg) in
171
+
let emit event = Event.emit event_bus event in
180
172
181
-
(* Create event bus *)
182
-
let event_bus = Event.create_bus () in
173
+
log "Starting ralph-loop agent";
174
+
Format.printf "@.%s%s═══ Project: %s ═══%s@." Color.bold Color.blue project Color.reset;
175
+
emit (Event.Text (Printf.sprintf "\n=== Starting ralph-loop for %s ===\n" project));
183
176
184
-
(* Helper to emit events *)
185
-
let emit event = Event.emit event_bus event in
177
+
(* Ensure working directory *)
178
+
let _work_dir = ensure_work_dir fs root project in
186
179
187
-
(* Run main agent logic in a switch *)
188
-
Eio.Switch.run @@ fun sw ->
180
+
(* Get project path *)
181
+
let project_path = Unpac.Worktree.path root (Unpac.Worktree.Project project) in
182
+
let project_dir = snd project_path in
189
183
190
-
(* Start web server if enabled *)
191
-
(match config.web_port with
192
-
| Some port ->
193
-
let _web = Web.start ~sw ~net ~port event_bus in
194
-
Log.info (fun m -> m "Web UI available at http://localhost:%d" port);
195
-
Format.printf "Web UI: http://localhost:%d@." port
196
-
| None -> ());
184
+
(* Generate the prompt (same prompt used every iteration - ralph-loop style) *)
185
+
let prompt = Prompt.generate_for_project ~proc_mgr ~root ~project in
197
186
198
-
(* Generate system prompt *)
199
-
let system_prompt = Prompt.generate ~proc_mgr ~root ~autonomous:config.autonomous in
200
-
Log.debug (fun m -> m "System prompt length: %d" (String.length system_prompt));
187
+
(* Create MCP server with custom unpac tools *)
188
+
let mcp_server = Tools.create_mcp_server ~proc_mgr ~fs ~root in
201
189
202
-
(* Build Claude options with our tools *)
203
-
let allowed_tools = List.map (fun (name, _, _) -> name) Tools.tool_schemas in
190
+
(* Build Claude options - always Opus 4.5 *)
191
+
(* Register MCP server so custom tools are available via mcp__unpac__<tool> *)
204
192
let options =
205
193
Claude.Options.default
206
-
|> Claude.Options.with_model (to_claude_model config.model)
207
-
|> Claude.Options.with_system_prompt system_prompt
208
-
|> Claude.Options.with_allowed_tools allowed_tools
194
+
|> Claude.Options.with_model (`Custom "claude-opus-4-5")
195
+
|> Claude.Options.with_system_prompt prompt
209
196
|> Claude.Options.with_permission_mode Claude.Permissions.Mode.Bypass_permissions
197
+
|> Claude.Options.with_mcp_server ~name:"unpac" mcp_server
210
198
in
211
199
212
-
(* Rate limit state *)
213
-
let rate_state = create_rate_limit_state () in
200
+
(* Ralph-loop: same prompt each iteration *)
201
+
let iteration_prompt = Printf.sprintf
202
+
"You are working on the '%s' project at %s.\n\n\
203
+
Analyze the project, make improvements, update STATUS.md, and commit changes.\n\n\
204
+
You have access to:\n\
205
+
- Claude's built-in tools: Read, Write, Edit, Bash, Glob, Grep\n\
206
+
- Custom unpac tools (mcp__unpac__*): unpac_status, unpac_git_list, etc.\n\n\
207
+
When ALL significant work is complete, output exactly: %s\n\n\
208
+
Begin."
209
+
project project_dir completion_promise
210
+
in
211
+
212
+
(* Run the ralph-loop *)
213
+
let rec ralph_loop iteration =
214
+
if iteration > config.max_iterations then begin
215
+
log (Printf.sprintf "Max iterations (%d) reached" config.max_iterations);
216
+
Format.printf "@.%s%s⚠ Max iterations (%d) reached%s@."
217
+
Color.bold Color.yellow config.max_iterations Color.reset;
218
+
emit (Event.Text (Printf.sprintf "\n[%s] Max iterations reached.\n" project))
219
+
end else begin
220
+
log (Printf.sprintf "Iteration %d/%d" iteration config.max_iterations);
221
+
Format.printf "@.%s%s── Iteration %d/%d ──%s@."
222
+
Color.bold Color.yellow iteration config.max_iterations Color.reset;
223
+
emit (Event.Text (Printf.sprintf "\n[%s] --- Iteration %d/%d ---\n"
224
+
project iteration config.max_iterations));
214
225
215
-
(* Emit agent start *)
216
-
emit Event.Agent_start;
226
+
let accumulated_response = ref "" in
227
+
let completion_detected = ref false in
228
+
let last_was_tool = ref false in
217
229
218
-
(* Main loop *)
219
-
let rec loop turn_count last_sync prompt =
220
-
(* Check turn limit *)
221
-
match config.max_turns with
222
-
| Some max when turn_count >= max ->
223
-
Format.printf "@.Reached maximum turns (%d). Exiting.@." max;
224
-
emit Event.Agent_stop
225
-
| _ ->
226
-
(* Check rate limit *)
227
-
(match should_wait_for_rate_limit ~clock rate_state with
228
-
| Some wait_time ->
229
-
Format.printf "Waiting %.0f seconds for rate limit...@." wait_time;
230
-
Eio.Time.sleep clock wait_time
231
-
| None -> ());
230
+
begin
231
+
try
232
+
Eio.Switch.run @@ fun inner_sw ->
233
+
let client = Claude.Client.create ~sw:inner_sw ~process_mgr:proc_mgr
234
+
~clock:(Eio.Stdenv.clock env) ~options () in
232
235
233
-
(* Check if we should sync *)
234
-
let should_sync = config.autonomous &&
235
-
turn_count > 0 &&
236
-
turn_count - last_sync >= config.sync_interval in
237
-
let (prompt, last_sync) =
238
-
if should_sync then begin
239
-
Log.info (fun m -> m "Periodic sync: running unpac status and push");
240
-
emit (Event.Sync "status");
241
-
("First run unpac_status_sync to update the workspace status, then run \
242
-
unpac_push with remote='origin' to sync changes. After that, continue \
243
-
analyzing and improving the codebase.", turn_count)
244
-
end else
245
-
(prompt, last_sync)
246
-
in
236
+
emit Event.Thinking;
247
237
248
-
(* Create client and send message *)
249
-
let continue = ref true in
250
-
let error_occurred = ref false in
251
-
let turn_cost = ref None in
252
-
begin
253
-
try
254
-
Eio.Switch.run @@ fun sw ->
255
-
let client = Claude.Client.create ~sw ~process_mgr:proc_mgr ~clock ~options () in
238
+
let handler = object
239
+
inherit Claude.Handler.default
256
240
257
-
(* Emit thinking event *)
258
-
emit Event.Thinking;
241
+
method! on_text text =
242
+
let content = Claude.Response.Text.content text in
243
+
accumulated_response := !accumulated_response ^ content;
244
+
if !last_was_tool then begin
245
+
Format.printf "@.";
246
+
last_was_tool := false
247
+
end;
248
+
Format.printf "%s@?" content;
249
+
emit (Event.Text (Printf.sprintf "[%s] %s" project content));
250
+
if string_contains ~sub:completion_promise !accumulated_response then
251
+
completion_detected := true
259
252
260
-
(* Create response handler that handles tool calls *)
261
-
let handler = object
262
-
inherit Claude.Handler.default
253
+
method! on_thinking thinking =
254
+
let content = Claude.Response.Thinking.content thinking in
255
+
Format.printf "%s%s 💭 %s%s@." Color.dim Color.magenta content Color.reset
263
256
264
-
method! on_text text =
265
-
let content = Claude.Response.Text.content text in
266
-
print_string content;
267
-
flush stdout;
268
-
emit (Event.Text content)
257
+
method! on_tool_use tool =
258
+
(* Just log tool usage - execution is handled by Claude CLI for built-in
259
+
tools and by MCP server for custom tools *)
260
+
let name = Claude.Response.Tool_use.name tool in
261
+
let id = Claude.Response.Tool_use.id tool in
262
+
let input = Claude.Response.Tool_use.input tool in
269
263
270
-
method! on_tool_use tool =
271
-
let name = Claude.Response.Tool_use.name tool in
272
-
let id = Claude.Response.Tool_use.id tool in
273
-
let input = Claude.Response.Tool_use.input tool in
264
+
let call_summary = format_tool_call name input in
274
265
275
-
if config.verbose then
276
-
Log.info (fun m -> m "Tool call: %s" name);
266
+
if config.verbose then
267
+
log (Printf.sprintf "Tool %s (id: %s)" name id);
268
+
269
+
emit (Event.Tool_call { id; name; input = call_summary });
277
270
278
-
(* Convert Tool_input.t to Jsont.json *)
279
-
let json_input = Claude.Tool_input.to_json input in
280
-
let input_str = json_to_string json_input in
271
+
(* Print tool call with color *)
272
+
Format.printf " %s→%s %s@." Color.cyan Color.reset call_summary;
273
+
last_was_tool := true
281
274
282
-
(* Emit tool call event *)
283
-
emit (Event.Tool_call { id; name; input = input_str });
275
+
method! on_tool_result result =
276
+
(* Log tool results for observability *)
277
+
let tool_use_id = Claude.Content_block.Tool_result.tool_use_id result in
278
+
let is_error = Claude.Content_block.Tool_result.is_error result
279
+
|> Option.value ~default:false in
280
+
let result_color = if is_error then Color.red else Color.green in
281
+
let status = if is_error then "ERROR" else "ok" in
282
+
Format.printf " %s←%s %s@." result_color Color.reset status;
283
+
emit (Event.Tool_result { id = tool_use_id; name = ""; output = status; is_error })
284
284
285
-
(* Execute the tool *)
286
-
let result = Tools.execute ~proc_mgr ~fs ~root ~tool_name:name ~input:json_input in
287
-
let (is_error, content) = match result with
288
-
| Tools.Success s -> (false, s)
289
-
| Tools.Error e -> (true, e)
290
-
in
285
+
method! on_complete result =
286
+
let cost = Claude.Response.Complete.total_cost_usd result in
287
+
emit (Event.Turn_complete { turn = iteration; cost_usd = cost })
291
288
292
-
(* Emit tool result event *)
293
-
emit (Event.Tool_result { id; name; output = content; is_error });
289
+
method! on_error err =
290
+
let msg = Claude.Response.Error.message err in
291
+
log (Printf.sprintf "Error: %s" msg);
292
+
Format.printf "%s%sError: %s%s@." Color.bold Color.red msg Color.reset;
293
+
emit (Event.Error (Printf.sprintf "[%s] %s" project msg))
294
+
end in
294
295
295
-
if config.verbose then
296
-
Log.info (fun m -> m "Tool result: %s..."
297
-
(String.sub content 0 (min 100 (String.length content))));
296
+
(* Same prompt every iteration - ralph-loop style *)
297
+
Claude.Client.query client iteration_prompt;
298
+
Claude.Client.run client ~handler
299
+
with exn ->
300
+
let msg = Printexc.to_string exn in
301
+
log (Printf.sprintf "Exception: %s" msg);
302
+
emit (Event.Error (Printf.sprintf "[%s] %s" project msg))
303
+
end;
298
304
299
-
(* Send tool result back to Claude *)
300
-
let meta = Jsont.Meta.none in
301
-
let content_json = Jsont.String (content, meta) in
302
-
Claude.Client.respond_to_tool client ~tool_use_id:id ~content:content_json ~is_error ()
305
+
(* Check if we should stop *)
306
+
if !completion_detected then begin
307
+
log "Completion promise detected!";
308
+
Format.printf "@.%s%s✓ Completion promise detected%s@." Color.bold Color.green Color.reset;
309
+
emit (Event.Text (Printf.sprintf "\n[%s] ✓ Completion promise detected.\n" project))
310
+
end else
311
+
ralph_loop (iteration + 1)
312
+
end
313
+
in
303
314
304
-
method! on_complete result =
305
-
print_newline ();
306
-
record_success rate_state;
307
-
let cost = Claude.Response.Complete.total_cost_usd result in
308
-
turn_cost := cost;
309
-
if config.verbose then begin
310
-
match cost with
311
-
| Some c -> Log.info (fun m -> m "Turn complete, cost: $%.4f" c)
312
-
| None -> Log.info (fun m -> m "Turn complete")
313
-
end
315
+
ralph_loop 1;
316
+
log "Ralph-loop complete";
317
+
Format.printf "@.%s%s─── Project complete: %s ───%s@." Color.dim Color.blue project Color.reset;
318
+
emit (Event.Text (Printf.sprintf "\n=== Ralph-loop complete for %s ===\n" project))
314
319
315
-
method! on_error err =
316
-
let msg = Claude.Response.Error.message err in
317
-
Log.err (fun m -> m "Claude error: %s" msg);
318
-
emit (Event.Error msg);
319
-
if is_rate_limit_error msg then begin
320
-
let delay = record_rate_limit_error ~clock rate_state in
321
-
Format.eprintf "Rate limit hit, will retry in %.0f seconds@." delay
322
-
end;
323
-
error_occurred := true
324
-
end in
320
+
(* Main entry point *)
321
+
let run ~env ~config ~workspace_path () =
322
+
Random.self_init ();
325
323
326
-
(* Send the prompt and run handler *)
327
-
Claude.Client.query client prompt;
328
-
Claude.Client.run client ~handler
329
-
with exn ->
330
-
let msg = Printexc.to_string exn in
331
-
Log.err (fun m -> m "Exception: %s" msg);
332
-
emit (Event.Error msg);
333
-
if is_rate_limit_error msg then begin
334
-
let delay = record_rate_limit_error ~clock rate_state in
335
-
Format.eprintf "Rate limit exception, will retry in %.0f seconds@." delay
336
-
end;
337
-
error_occurred := true
338
-
end;
324
+
let fs = Eio.Stdenv.fs env in
325
+
let net = Eio.Stdenv.net env in
339
326
340
-
(* Emit turn complete *)
341
-
emit (Event.Turn_complete { turn = turn_count; cost_usd = !turn_cost });
327
+
(* Find unpac root *)
328
+
let root = match find_root_from fs workspace_path with
329
+
| Some r -> r
330
+
| None ->
331
+
Format.eprintf "Error: '%s' is not an unpac workspace.@." workspace_path;
332
+
exit 1
333
+
in
342
334
343
-
(* Handle next iteration *)
344
-
if !error_occurred && config.autonomous then begin
345
-
(* In autonomous mode, retry after error with backoff *)
346
-
Log.info (fun m -> m "Error occurred, will retry...");
347
-
loop turn_count last_sync "Continue with your analysis. If you encountered an error, try a different approach."
348
-
end else if config.autonomous then begin
349
-
(* Autonomous mode: continue automatically *)
350
-
print_newline ();
351
-
loop (turn_count + 1) last_sync
352
-
"Continue analyzing and improving the projects. Remember to:\n\
353
-
1. Update STATUS.md with your findings\n\
354
-
2. Make small, focused improvements\n\
355
-
3. Commit changes with clear messages\n\
356
-
4. Run dune build to verify changes work\n\
357
-
If you've completed analysis of all projects, focus on the highest priority improvements."
358
-
end else begin
359
-
(* Interactive mode: prompt for next input *)
360
-
print_newline ();
361
-
print_string "> ";
362
-
flush stdout;
335
+
Log.info (fun m -> m "Starting ralph-loop agent in workspace: %s" (snd root));
363
336
364
-
(* Read next user input *)
365
-
let next_prompt =
366
-
try Some (input_line stdin)
367
-
with End_of_file -> continue := false; None
368
-
in
337
+
(* Get projects to process *)
338
+
let all_projects = Unpac.Worktree.list_projects ~proc_mgr:(Eio.Stdenv.process_mgr env) root in
369
339
370
-
match next_prompt with
371
-
| None -> emit Event.Agent_stop
372
-
| Some "" -> loop (turn_count + 1) last_sync "Continue with the current task."
373
-
| Some "exit" | Some "quit" ->
374
-
emit Event.Agent_stop;
375
-
Format.printf "Goodbye!@."
376
-
| Some p -> loop (turn_count + 1) last_sync p
377
-
end
378
-
in
340
+
if all_projects = [] then begin
341
+
Format.eprintf "No projects found in workspace.@.";
342
+
exit 1
343
+
end;
379
344
380
-
(* Start the loop *)
381
-
let start_prompt = match initial_prompt with
382
-
| Some p -> p
383
-
| None ->
384
-
if config.autonomous then
385
-
"Start your autonomous analysis of the workspace. List all projects, \
386
-
then systematically analyze each one. For each project:\n\
387
-
1. Check if STATUS.md exists and read it\n\
388
-
2. List all source files\n\
389
-
3. Read key files to understand the code\n\
390
-
4. Check for tests\n\
391
-
5. Update STATUS.md with your findings\n\
392
-
6. Identify opportunities for code improvement\n\
393
-
Begin now."
345
+
let projects = match config.project with
346
+
| Some p ->
347
+
if List.mem p all_projects then [p]
394
348
else begin
395
-
print_string "unpac-claude> What would you like me to help with?\n> ";
396
-
flush stdout;
397
-
input_line stdin
349
+
Format.eprintf "Project '%s' not found. Available: %s@."
350
+
p (String.concat ", " all_projects);
351
+
exit 1
398
352
end
353
+
| None ->
354
+
shuffle all_projects
399
355
in
400
356
401
-
print_newline ();
402
-
loop 0 0 start_prompt
357
+
Log.info (fun m -> m "Projects to process: %s" (String.concat ", " projects));
358
+
359
+
(* Create shared event bus *)
360
+
let event_bus = Event.create_bus () in
361
+
362
+
Eio.Switch.run @@ fun sw ->
363
+
364
+
(* Start web server if enabled *)
365
+
(match config.web_port with
366
+
| Some port ->
367
+
let _web = Web.start ~sw ~net ~port event_bus in
368
+
Log.info (fun m -> m "Web UI available at http://localhost:%d" port);
369
+
Format.printf "Web UI: http://localhost:%d@." port
370
+
| None -> ());
371
+
372
+
Event.emit event_bus Event.Agent_start;
373
+
374
+
Format.printf "%s%sRalph-loop agent starting...%s@." Color.bold Color.cyan Color.reset;
375
+
Format.printf " %sModel:%s Opus 4.5@." Color.dim Color.reset;
376
+
Format.printf " %sMax iterations:%s %d@." Color.dim Color.reset config.max_iterations;
377
+
Format.printf " %sCompletion promise:%s %s@." Color.dim Color.reset completion_promise;
378
+
Format.printf " %sCustom tools:%s mcp__unpac__* (via MCP server)@." Color.dim Color.reset;
379
+
Format.printf " %sProjects (%d):%s %s@."
380
+
Color.dim (List.length projects) Color.reset (String.concat ", " projects);
381
+
382
+
(* Process projects sequentially *)
383
+
List.iter (fun project ->
384
+
run_project_ralph_loop ~env ~config ~root ~project ~event_bus
385
+
) projects;
386
+
387
+
Event.emit event_bus Event.Agent_stop;
388
+
389
+
Format.printf "@.%s%s✓ All projects complete.%s@." Color.bold Color.green Color.reset
+25
-21
lib/claude/agent.mli
+25
-21
lib/claude/agent.mli
···
1
-
(** Autonomous Claude agent for unpac workflows.
1
+
(** Ralph-loop style Claude agent for unpac workspace analysis.
2
2
3
-
Runs an interactive loop that:
4
-
1. Takes user input or autonomous goals
5
-
2. Executes tool calls as needed
6
-
3. Continues until user interrupt (Ctrl+C) *)
3
+
Runs a single autonomous agent per project using ralph-loop iteration:
4
+
- Same prompt fed each iteration (state persists in files)
5
+
- Up to 20 iterations per project
6
+
- Early exit on completion promise
7
+
- Projects processed sequentially in random order *)
7
8
8
9
(** {1 Agent Configuration} *)
9
10
10
11
type config = {
11
-
model : [ `Sonnet | `Opus | `Haiku ];
12
-
max_turns : int option; (** None = unlimited *)
13
12
verbose : bool;
14
-
autonomous : bool; (** Autonomous mode - continuous analysis *)
15
-
sync_interval : int; (** Turns between unpac status/push in autonomous mode *)
16
13
web_port : int option; (** Port for web UI, None = disabled *)
14
+
max_iterations : int; (** Max ralph-loop iterations per project *)
15
+
project : string option; (** Specific project, or None for all *)
17
16
}
18
17
19
18
val default_config : config
20
19
21
-
(** {1 Running the Agent} *)
20
+
(** {1 Completion Promise} *)
21
+
22
+
val completion_promise : string
23
+
(** The phrase that signals work is complete: "AGENTIC-HUMPS-COUNT-2" *)
24
+
25
+
(** {1 Running Agents} *)
22
26
23
27
val run :
24
28
env:Eio_unix.Stdenv.base ->
25
29
config:config ->
26
-
initial_prompt:string option ->
27
-
?workspace_path:string ->
30
+
workspace_path:string ->
28
31
unit ->
29
32
unit
30
-
(** [run ~env ~config ~initial_prompt ?workspace_path ()] starts the agent loop.
33
+
(** [run ~env ~config ~workspace_path ()] runs ralph-loop agents for projects
34
+
in the workspace.
31
35
32
-
If [initial_prompt] is provided, the agent starts working on that goal.
33
-
Otherwise, it enters an interactive mode waiting for user input.
36
+
If [config.project] is specified, runs only that project.
37
+
Otherwise, runs all projects sequentially in random order.
34
38
35
-
If [workspace_path] is provided, the agent starts in that workspace.
36
-
Otherwise, it searches upward from the current directory.
39
+
Each project agent:
40
+
- Uses Opus 4.5 model
41
+
- Runs up to [max_iterations] iterations
42
+
- Exits early if response contains [completion_promise]
43
+
- Works from [workspace/.unpac-claude/project/] directory
37
44
38
-
The agent runs until:
39
-
- User presses Ctrl+C
40
-
- [max_turns] is reached (if configured)
41
-
- The agent explicitly signals completion *)
45
+
The function blocks until all projects complete. *)
+228
-306
lib/claude/tools.ml
+228
-306
lib/claude/tools.ml
···
1
-
(** Tool definitions for Claude to interact with unpac and analyze code. *)
1
+
(** Tool definitions for Claude to interact with unpac and analyze code.
2
+
3
+
Uses the Claude SDK's MCP-based custom tool architecture. Tools are
4
+
defined as Claude.Tool.t values and bundled into an Mcp_server that
5
+
gets registered with the Claude client. *)
2
6
3
7
let src = Logs.Src.create "unpac.claude.tools" ~doc:"Claude tools"
4
8
module Log = (val Logs.src_log src : Logs.LOG)
5
9
6
-
type tool_result =
7
-
| Success of string
8
-
| Error of string
9
-
10
10
(* Helper to truncate long output *)
11
11
let truncate_output ?(max_len=50000) s =
12
12
if String.length s > max_len then
13
13
String.sub s 0 max_len ^ "\n\n[... truncated ...]"
14
14
else s
15
15
16
+
(* Tool result helpers - convert to Claude.Tool format *)
17
+
let ok s = Ok (Claude.Tool.text_result s)
18
+
let err s = Error s
19
+
20
+
(* === TOOL IMPLEMENTATIONS === *)
21
+
16
22
(* Git list tool *)
17
-
let git_list ~proc_mgr ~root =
23
+
let git_list ~proc_mgr ~root () =
18
24
try
19
25
let repos = Unpac.Git_backend.list_repos ~proc_mgr ~root in
20
26
if repos = [] then
21
-
Success "No git repositories vendored.\n\nTo add one: use git_add tool with url parameter."
27
+
ok "No git repositories vendored.\n\nTo add one: use git_add tool with url parameter."
22
28
else
23
29
let buf = Buffer.create 256 in
24
30
Buffer.add_string buf "Vendored git repositories:\n";
25
31
List.iter (fun r -> Buffer.add_string buf (Printf.sprintf "- %s\n" r)) repos;
26
-
Success (Buffer.contents buf)
32
+
ok (Buffer.contents buf)
27
33
with exn ->
28
-
Error (Printf.sprintf "Failed to list git repos: %s" (Printexc.to_string exn))
34
+
err (Printf.sprintf "Failed to list git repos: %s" (Printexc.to_string exn))
29
35
30
36
(* Git add tool *)
31
37
let git_add ~proc_mgr ~fs ~root ~url ?name ?branch ?subdir () =
32
38
try
33
-
(* Derive name from URL if not specified *)
34
39
let repo_name = match name with
35
40
| Some n -> n
36
41
| None ->
···
47
52
subdir;
48
53
} in
49
54
50
-
(* Try to resolve cache from config *)
51
55
let config_path = Filename.concat (snd (Unpac.Worktree.path root Unpac.Worktree.Main))
52
56
"unpac.toml" in
53
57
let cache = if Sys.file_exists config_path then begin
···
63
67
64
68
match Unpac.Git_backend.add_repo ~proc_mgr ~root ?cache info with
65
69
| Unpac.Backend.Added { name = added_name; sha } ->
66
-
Success (Printf.sprintf
70
+
ok (Printf.sprintf
67
71
"Successfully added repository '%s' (commit %s).\n\n\
68
72
Next steps:\n\
69
73
- Use git_info %s to see repository details\n\
···
71
75
- Merge into a project when ready" added_name (String.sub sha 0 7)
72
76
added_name added_name)
73
77
| Unpac.Backend.Already_exists name ->
74
-
Success (Printf.sprintf "Repository '%s' is already vendored." name)
78
+
ok (Printf.sprintf "Repository '%s' is already vendored." name)
75
79
| Unpac.Backend.Failed { name; error } ->
76
-
Error (Printf.sprintf "Failed to add '%s': %s" name error)
80
+
err (Printf.sprintf "Failed to add '%s': %s" name error)
77
81
with exn ->
78
-
Error (Printf.sprintf "Failed to add repository: %s" (Printexc.to_string exn))
82
+
err (Printf.sprintf "Failed to add repository: %s" (Printexc.to_string exn))
79
83
80
84
(* Git info tool *)
81
-
let git_info ~proc_mgr ~root ~name =
85
+
let git_info ~proc_mgr ~root ~name () =
82
86
try
83
87
let git = Unpac.Worktree.git_dir root in
84
88
let repos = Unpac.Git_backend.list_repos ~proc_mgr ~root in
85
89
if not (List.mem name repos) then
86
-
Error (Printf.sprintf "Repository '%s' is not vendored" name)
90
+
err (Printf.sprintf "Repository '%s' is not vendored" name)
87
91
else begin
88
92
let buf = Buffer.create 512 in
89
93
let add s = Buffer.add_string buf s in
90
94
91
95
add (Printf.sprintf "Repository: %s\n" name);
92
96
93
-
(* Get remote URL *)
94
97
let remote = "origin-" ^ name in
95
98
(match Unpac.Git.remote_url ~proc_mgr ~cwd:git remote with
96
99
| Some u -> add (Printf.sprintf "URL: %s\n" u)
97
100
| None -> ());
98
101
99
-
(* Get branch SHAs *)
100
102
let upstream = Unpac.Git_backend.upstream_branch name in
101
103
let vendor = Unpac.Git_backend.vendor_branch name in
102
104
let patches = Unpac.Git_backend.patches_branch name in
···
111
113
| Some sha -> add (Printf.sprintf "Patches: %s\n" (String.sub sha 0 7))
112
114
| None -> ());
113
115
114
-
(* Count commits ahead *)
115
116
let log_output = Unpac.Git.run_exn ~proc_mgr ~cwd:git
116
117
["log"; "--oneline"; vendor ^ ".." ^ patches] in
117
118
let commits = List.length (String.split_on_char '\n' log_output |>
118
119
List.filter (fun s -> String.trim s <> "")) in
119
120
add (Printf.sprintf "Local commits: %d\n" commits);
120
121
121
-
Success (Buffer.contents buf)
122
+
ok (Buffer.contents buf)
122
123
end
123
124
with exn ->
124
-
Error (Printf.sprintf "Failed to get info for '%s': %s" name (Printexc.to_string exn))
125
+
err (Printf.sprintf "Failed to get info for '%s': %s" name (Printexc.to_string exn))
125
126
126
127
(* Git diff tool *)
127
-
let git_diff ~proc_mgr ~root ~name =
128
+
let git_diff ~proc_mgr ~root ~name () =
128
129
try
129
130
let git = Unpac.Worktree.git_dir root in
130
131
let repos = Unpac.Git_backend.list_repos ~proc_mgr ~root in
131
132
if not (List.mem name repos) then
132
-
Error (Printf.sprintf "Repository '%s' is not vendored" name)
133
+
err (Printf.sprintf "Repository '%s' is not vendored" name)
133
134
else begin
134
135
let vendor = Unpac.Git_backend.vendor_branch name in
135
136
let patches = Unpac.Git_backend.patches_branch name in
136
137
let diff = Unpac.Git.run_exn ~proc_mgr ~cwd:git ["diff"; vendor; patches] in
137
138
if String.trim diff = "" then
138
-
Success (Printf.sprintf "No local changes in '%s'." name)
139
+
ok (Printf.sprintf "No local changes in '%s'." name)
139
140
else
140
-
Success (truncate_output (Printf.sprintf "Diff for '%s':\n\n%s" name diff))
141
+
ok (truncate_output (Printf.sprintf "Diff for '%s':\n\n%s" name diff))
141
142
end
142
143
with exn ->
143
-
Error (Printf.sprintf "Failed to get diff for '%s': %s" name (Printexc.to_string exn))
144
+
err (Printf.sprintf "Failed to get diff for '%s': %s" name (Printexc.to_string exn))
144
145
145
146
(* Opam list tool *)
146
-
let opam_list ~proc_mgr ~root =
147
+
let opam_list ~proc_mgr ~root () =
147
148
try
148
149
let pkgs = Unpac.Worktree.list_opam_packages ~proc_mgr root in
149
150
if pkgs = [] then
150
-
Success "No opam packages vendored."
151
+
ok "No opam packages vendored."
151
152
else begin
152
153
let buf = Buffer.create 256 in
153
154
Buffer.add_string buf "Vendored opam packages:\n";
154
155
List.iter (fun p -> Buffer.add_string buf (Printf.sprintf "- %s\n" p)) pkgs;
155
-
Success (Buffer.contents buf)
156
+
ok (Buffer.contents buf)
156
157
end
157
158
with exn ->
158
-
Error (Printf.sprintf "Failed to list opam packages: %s" (Printexc.to_string exn))
159
+
err (Printf.sprintf "Failed to list opam packages: %s" (Printexc.to_string exn))
159
160
160
161
(* Project list tool *)
161
-
let project_list ~proc_mgr ~root =
162
+
let project_list ~proc_mgr ~root () =
162
163
try
163
164
let projects = Unpac.Worktree.list_projects ~proc_mgr root in
164
165
if projects = [] then
165
-
Success "No projects configured."
166
+
ok "No projects configured."
166
167
else begin
167
168
let buf = Buffer.create 256 in
168
169
Buffer.add_string buf "Projects:\n";
169
170
List.iter (fun p -> Buffer.add_string buf (Printf.sprintf "- %s\n" p)) projects;
170
-
Success (Buffer.contents buf)
171
+
ok (Buffer.contents buf)
171
172
end
172
173
with exn ->
173
-
Error (Printf.sprintf "Failed to list projects: %s" (Printexc.to_string exn))
174
+
err (Printf.sprintf "Failed to list projects: %s" (Printexc.to_string exn))
174
175
175
176
(* Status tool - overview of the workspace *)
176
-
let status ~proc_mgr ~root =
177
+
let status ~proc_mgr ~root () =
177
178
try
178
179
let buf = Buffer.create 1024 in
179
180
let add s = Buffer.add_string buf s in
180
181
181
182
add "=== Unpac Workspace Status ===\n\n";
182
183
183
-
(* Projects *)
184
184
let projects = Unpac.Worktree.list_projects ~proc_mgr root in
185
185
add (Printf.sprintf "Projects (%d):\n" (List.length projects));
186
186
List.iter (fun p -> add (Printf.sprintf " - %s\n" p)) projects;
187
187
if projects = [] then add " (none)\n";
188
188
add "\n";
189
189
190
-
(* Git repos *)
191
190
let git_repos = Unpac.Git_backend.list_repos ~proc_mgr ~root in
192
191
add (Printf.sprintf "Git Repositories (%d):\n" (List.length git_repos));
193
192
List.iter (fun r -> add (Printf.sprintf " - %s\n" r)) git_repos;
194
193
if git_repos = [] then add " (none)\n";
195
194
add "\n";
196
195
197
-
(* Opam packages *)
198
196
let opam_pkgs = Unpac.Worktree.list_opam_packages ~proc_mgr root in
199
197
add (Printf.sprintf "Opam Packages (%d):\n" (List.length opam_pkgs));
200
198
List.iter (fun p -> add (Printf.sprintf " - %s\n" p)) opam_pkgs;
201
199
if opam_pkgs = [] then add " (none)\n";
202
200
203
-
Success (Buffer.contents buf)
201
+
ok (Buffer.contents buf)
204
202
with exn ->
205
-
Error (Printf.sprintf "Failed to get status: %s" (Printexc.to_string exn))
206
-
207
-
(* === NEW FILE OPERATION TOOLS === *)
203
+
err (Printf.sprintf "Failed to get status: %s" (Printexc.to_string exn))
208
204
209
205
(* Read file tool *)
210
-
let read_file ~fs ~path =
206
+
let read_file ~fs ~path () =
211
207
try
212
208
let full_path = Eio.Path.(fs / path) in
213
209
if not (Eio.Path.is_file full_path) then
214
-
Error (Printf.sprintf "File not found: %s" path)
210
+
err (Printf.sprintf "File not found: %s" path)
215
211
else begin
216
212
let content = Eio.Path.load full_path in
217
-
Success (truncate_output content)
213
+
ok (truncate_output content)
218
214
end
219
215
with exn ->
220
-
Error (Printf.sprintf "Failed to read '%s': %s" path (Printexc.to_string exn))
216
+
err (Printf.sprintf "Failed to read '%s': %s" path (Printexc.to_string exn))
221
217
222
218
(* Write file tool *)
223
-
let write_file ~fs ~path ~content =
219
+
let write_file ~fs ~path ~content () =
224
220
try
225
221
let full_path = Eio.Path.(fs / path) in
226
-
(* Ensure parent directory exists *)
227
222
let parent = Filename.dirname path in
228
223
if parent <> "." && parent <> "/" then begin
229
224
let parent_path = Eio.Path.(fs / parent) in
230
225
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 parent_path
231
226
end;
232
227
Eio.Path.save ~create:(`Or_truncate 0o644) full_path content;
233
-
Success (Printf.sprintf "Successfully wrote %d bytes to %s" (String.length content) path)
228
+
ok (Printf.sprintf "Successfully wrote %d bytes to %s" (String.length content) path)
234
229
with exn ->
235
-
Error (Printf.sprintf "Failed to write '%s': %s" path (Printexc.to_string exn))
230
+
err (Printf.sprintf "Failed to write '%s': %s" path (Printexc.to_string exn))
236
231
237
232
(* List directory tool *)
238
-
let list_dir ~fs ~path =
233
+
let list_dir ~fs ~path () =
239
234
try
240
235
let full_path = Eio.Path.(fs / path) in
241
236
if not (Eio.Path.is_directory full_path) then
242
-
Error (Printf.sprintf "Not a directory: %s" path)
237
+
err (Printf.sprintf "Not a directory: %s" path)
243
238
else begin
244
239
let entries = Eio.Path.read_dir full_path in
245
240
let entries = List.sort String.compare entries in
···
250
245
let suffix = if Eio.Path.is_directory entry_path then "/" else "" in
251
246
Buffer.add_string buf (Printf.sprintf " %s%s\n" e suffix)
252
247
) entries;
253
-
Success (Buffer.contents buf)
248
+
ok (Buffer.contents buf)
254
249
end
255
250
with exn ->
256
-
Error (Printf.sprintf "Failed to list '%s': %s" path (Printexc.to_string exn))
251
+
err (Printf.sprintf "Failed to list '%s': %s" path (Printexc.to_string exn))
257
252
258
253
(* Glob files tool *)
259
-
let glob_files ~fs ~pattern ~base_path =
254
+
let glob_files ~fs ~pattern ~base_path () =
260
255
try
261
256
let full_base = Eio.Path.(fs / base_path) in
262
257
if not (Eio.Path.is_directory full_base) then
263
-
Error (Printf.sprintf "Base path not a directory: %s" base_path)
258
+
err (Printf.sprintf "Base path not a directory: %s" base_path)
264
259
else begin
265
260
let results = ref [] in
266
261
let rec walk dir rel_path =
···
271
266
if Eio.Path.is_directory entry_path then
272
267
walk entry_path rel
273
268
else begin
274
-
(* Simple glob matching - support *.ml, **/*.ml patterns *)
275
269
let matches =
276
270
if String.starts_with ~prefix:"**/" pattern then
277
271
let ext = String.sub pattern 3 (String.length pattern - 3) in
···
289
283
walk full_base "";
290
284
let files = List.sort String.compare !results in
291
285
if files = [] then
292
-
Success (Printf.sprintf "No files matching '%s' in %s" pattern base_path)
286
+
ok (Printf.sprintf "No files matching '%s' in %s" pattern base_path)
293
287
else begin
294
288
let buf = Buffer.create 256 in
295
289
Buffer.add_string buf (Printf.sprintf "Files matching '%s' in %s:\n" pattern base_path);
296
290
List.iter (fun f -> Buffer.add_string buf (Printf.sprintf " %s\n" f)) files;
297
-
Success (Buffer.contents buf)
291
+
ok (Buffer.contents buf)
298
292
end
299
293
end
300
294
with exn ->
301
-
Error (Printf.sprintf "Failed to glob '%s': %s" pattern (Printexc.to_string exn))
295
+
err (Printf.sprintf "Failed to glob '%s': %s" pattern (Printexc.to_string exn))
302
296
303
-
(* === SHELL EXECUTION TOOL === *)
304
-
305
-
let run_shell ~proc_mgr ~fs ~cwd ~command ~timeout_sec:_ =
297
+
(* Shell execution tool *)
298
+
let run_shell ~proc_mgr ~fs ~cwd ~command () =
306
299
try
307
300
let result = Eio.Switch.run @@ fun sw ->
308
301
let stdout_buf = Buffer.create 4096 in
···
320
313
Eio.Flow.close stdout_w;
321
314
Eio.Flow.close stderr_w;
322
315
323
-
(* Read output concurrently *)
324
316
Eio.Fiber.both
325
317
(fun () ->
326
318
let chunk = Cstruct.create 4096 in
···
362
354
Buffer.add_string buf stderr
363
355
end;
364
356
if exit_code = 0 then
365
-
Success (truncate_output (Buffer.contents buf))
357
+
ok (truncate_output (Buffer.contents buf))
366
358
else
367
-
Error (truncate_output (Buffer.contents buf))
359
+
err (truncate_output (Buffer.contents buf))
368
360
with exn ->
369
-
Error (Printf.sprintf "Failed to run command: %s" (Printexc.to_string exn))
361
+
err (Printf.sprintf "Failed to run command: %s" (Printexc.to_string exn))
370
362
371
-
(* === UNPAC SYNC TOOLS === *)
372
-
373
-
let unpac_status_sync ~proc_mgr ~root =
363
+
(* Unpac status sync *)
364
+
let unpac_status_sync ~proc_mgr ~root () =
374
365
try
375
366
let main_wt = Unpac.Worktree.path root Unpac.Worktree.Main in
376
367
let result = Eio.Switch.run @@ fun sw ->
···
406
397
ignore (Eio.Process.await child);
407
398
Buffer.contents stdout_buf
408
399
in
409
-
Success (Printf.sprintf "Ran unpac status:\n%s" (truncate_output result))
400
+
ok (Printf.sprintf "Ran unpac status:\n%s" (truncate_output result))
410
401
with exn ->
411
-
Error (Printf.sprintf "Failed to run unpac status: %s" (Printexc.to_string exn))
402
+
err (Printf.sprintf "Failed to run unpac status: %s" (Printexc.to_string exn))
412
403
413
-
let unpac_push ~proc_mgr ~root ~remote =
404
+
(* Unpac push *)
405
+
let unpac_push ~proc_mgr ~root ~remote () =
414
406
try
415
407
let main_wt = Unpac.Worktree.path root Unpac.Worktree.Main in
416
408
let result = Eio.Switch.run @@ fun sw ->
···
451
443
let (status, stdout, stderr) = result in
452
444
let exit_code = match status with `Exited c -> c | `Signaled s -> 128 + s in
453
445
if exit_code = 0 then
454
-
Success (Printf.sprintf "Pushed to %s:\n%s" remote (truncate_output stdout))
446
+
ok (Printf.sprintf "Pushed to %s:\n%s" remote (truncate_output stdout))
455
447
else
456
-
Error (Printf.sprintf "Push failed (exit %d):\n%s\n%s" exit_code stdout stderr)
448
+
err (Printf.sprintf "Push failed (exit %d):\n%s\n%s" exit_code stdout stderr)
457
449
with exn ->
458
-
Error (Printf.sprintf "Failed to push: %s" (Printexc.to_string exn))
450
+
err (Printf.sprintf "Failed to push: %s" (Printexc.to_string exn))
459
451
460
-
(* === GIT COMMIT TOOL === *)
461
-
462
-
let git_commit ~proc_mgr ~cwd ~message =
452
+
(* Git commit tool *)
453
+
let git_commit ~proc_mgr ~cwd ~message () =
463
454
try
464
455
let result = Eio.Switch.run @@ fun sw ->
465
-
(* First add all changes *)
466
456
let add_child = Eio.Process.spawn proc_mgr ~sw
467
457
~cwd:(cwd :> Eio.Fs.dir_ty Eio.Path.t)
468
458
["git"; "add"; "-A"]
···
472
462
| `Exited 0 -> ()
473
463
| _ -> failwith "git add failed");
474
464
475
-
(* Then commit *)
476
465
let stdout_r, stdout_w = Eio.Process.pipe proc_mgr ~sw in
477
466
let stderr_r, stderr_w = Eio.Process.pipe proc_mgr ~sw in
478
467
let stdout_buf = Buffer.create 256 in
···
507
496
in
508
497
let (status, stdout, stderr) = result in
509
498
match status with
510
-
| `Exited 0 -> Success (Printf.sprintf "Committed:\n%s" stdout)
499
+
| `Exited 0 -> ok (Printf.sprintf "Committed:\n%s" stdout)
511
500
| `Exited 1 when String.length stdout > 0 ->
512
-
Success "Nothing to commit (working tree clean)"
513
-
| _ -> Error (Printf.sprintf "Commit failed:\n%s\n%s" stdout stderr)
501
+
ok "Nothing to commit (working tree clean)"
502
+
| _ -> err (Printf.sprintf "Commit failed:\n%s\n%s" stdout stderr)
514
503
with exn ->
515
-
Error (Printf.sprintf "Failed to commit: %s" (Printexc.to_string exn))
504
+
err (Printf.sprintf "Failed to commit: %s" (Printexc.to_string exn))
505
+
506
+
(* === MCP SERVER CREATION === *)
507
+
508
+
(** Create an MCP server with all unpac tools.
509
+
510
+
The server name will be "unpac" so tools are accessible as mcp__unpac__<tool_name>.
511
+
Call this with the Eio environment to create handlers with captured context. *)
512
+
let create_mcp_server ~proc_mgr ~fs ~root =
513
+
let open Claude.Tool in
516
514
517
-
(* Tool schemas for Claude *)
518
-
let tool_schemas : (string * string * Jsont.json) list =
519
-
let meta = Jsont.Meta.none in
520
-
let str s = Jsont.String (s, meta) in
521
-
let _int_t n = Jsont.Number (float_of_int n, meta) in
522
-
let arr l = Jsont.Array (l, meta) in
523
-
let obj l = Jsont.Object (List.map (fun (k, v) -> ((k, meta), v)) l, meta) in
524
-
let string_prop desc =
525
-
obj [("type", str "string"); ("description", str desc)]
526
-
in
527
-
let int_prop desc =
528
-
obj [("type", str "integer"); ("description", str desc)]
529
-
in
530
-
let make_schema required_props props =
531
-
obj [
532
-
("type", str "object");
533
-
("properties", obj props);
534
-
("required", arr (List.map str required_props));
535
-
]
536
-
in
537
-
[
515
+
let tools = [
538
516
(* Workspace status tools *)
539
-
("unpac_status",
540
-
"Get an overview of the unpac workspace, including all projects, \
541
-
vendored git repositories, and opam packages.",
542
-
make_schema [] []);
517
+
create
518
+
~name:"unpac_status"
519
+
~description:"Get an overview of the unpac workspace, including all projects, \
520
+
vendored git repositories, and opam packages."
521
+
~input_schema:(schema_object [] ~required:[])
522
+
~handler:(fun _args -> status ~proc_mgr ~root ());
543
523
544
-
("unpac_status_sync",
545
-
"Run 'unpac status' to update README.md and sync workspace state. \
546
-
Call this periodically to keep the workspace documentation current.",
547
-
make_schema [] []);
524
+
create
525
+
~name:"unpac_status_sync"
526
+
~description:"Run 'unpac status' to update README.md and sync workspace state. \
527
+
Call this periodically to keep the workspace documentation current."
528
+
~input_schema:(schema_object [] ~required:[])
529
+
~handler:(fun _args -> unpac_status_sync ~proc_mgr ~root ());
548
530
549
-
("unpac_push",
550
-
"Push all branches to the remote repository. Call this after making \
551
-
changes to sync with the remote.",
552
-
make_schema ["remote"] [
553
-
("remote", string_prop "Remote name to push to (usually 'origin')");
554
-
]);
531
+
create
532
+
~name:"unpac_push"
533
+
~description:"Push all branches to the remote repository. Call this after making \
534
+
changes to sync with the remote."
535
+
~input_schema:(schema_object [("remote", schema_string)] ~required:["remote"])
536
+
~handler:(fun args ->
537
+
match Claude.Tool_input.get_string args "remote" with
538
+
| None -> err "Missing required parameter: remote"
539
+
| Some remote -> unpac_push ~proc_mgr ~root ~remote ());
555
540
556
541
(* Git vendoring tools *)
557
-
("unpac_git_list",
558
-
"List all vendored git repositories in the workspace.",
559
-
make_schema [] []);
542
+
create
543
+
~name:"unpac_git_list"
544
+
~description:"List all vendored git repositories in the workspace."
545
+
~input_schema:(schema_object [] ~required:[])
546
+
~handler:(fun _args -> git_list ~proc_mgr ~root ());
560
547
561
-
("unpac_git_add",
562
-
"Vendor a new git repository. Clones the repo and creates the three-tier \
563
-
branch structure for conflict-free vendoring with full history preservation.",
564
-
make_schema ["url"] [
565
-
("url", string_prop "Git URL to clone from");
566
-
("name", string_prop "Override repository name (default: derived from URL)");
567
-
("branch", string_prop "Git branch or tag to vendor (default: remote default)");
568
-
("subdir", string_prop "Extract only this subdirectory from the repository");
569
-
]);
548
+
create
549
+
~name:"unpac_git_add"
550
+
~description:"Vendor a new git repository. Clones the repo and creates the three-tier \
551
+
branch structure for conflict-free vendoring with full history preservation."
552
+
~input_schema:(schema_object [
553
+
("url", schema_string);
554
+
("name", schema_string);
555
+
("branch", schema_string);
556
+
("subdir", schema_string);
557
+
] ~required:["url"])
558
+
~handler:(fun args ->
559
+
match Claude.Tool_input.get_string args "url" with
560
+
| None -> err "Missing required parameter: url"
561
+
| Some url ->
562
+
let name = Claude.Tool_input.get_string args "name" in
563
+
let branch = Claude.Tool_input.get_string args "branch" in
564
+
let subdir = Claude.Tool_input.get_string args "subdir" in
565
+
git_add ~proc_mgr ~fs ~root ~url ?name ?branch ?subdir ());
570
566
571
-
("unpac_git_info",
572
-
"Show detailed information about a vendored git repository, including \
573
-
branch SHAs and number of local commits.",
574
-
make_schema ["name"] [
575
-
("name", string_prop "Name of the vendored repository");
576
-
]);
567
+
create
568
+
~name:"unpac_git_info"
569
+
~description:"Show detailed information about a vendored git repository, including \
570
+
branch SHAs and number of local commits."
571
+
~input_schema:(schema_object [("name", schema_string)] ~required:["name"])
572
+
~handler:(fun args ->
573
+
match Claude.Tool_input.get_string args "name" with
574
+
| None -> err "Missing required parameter: name"
575
+
| Some name -> git_info ~proc_mgr ~root ~name ());
577
576
578
-
("unpac_git_diff",
579
-
"Show the diff between vendor and patches branches for a git repository. \
580
-
This shows what local modifications have been made.",
581
-
make_schema ["name"] [
582
-
("name", string_prop "Name of the vendored repository");
583
-
]);
577
+
create
578
+
~name:"unpac_git_diff"
579
+
~description:"Show the diff between vendor and patches branches for a git repository. \
580
+
This shows what local modifications have been made."
581
+
~input_schema:(schema_object [("name", schema_string)] ~required:["name"])
582
+
~handler:(fun args ->
583
+
match Claude.Tool_input.get_string args "name" with
584
+
| None -> err "Missing required parameter: name"
585
+
| Some name -> git_diff ~proc_mgr ~root ~name ());
584
586
585
587
(* Opam tools *)
586
-
("unpac_opam_list",
587
-
"List all vendored opam packages in the workspace.",
588
-
make_schema [] []);
588
+
create
589
+
~name:"unpac_opam_list"
590
+
~description:"List all vendored opam packages in the workspace."
591
+
~input_schema:(schema_object [] ~required:[])
592
+
~handler:(fun _args -> opam_list ~proc_mgr ~root ());
589
593
590
-
("unpac_project_list",
591
-
"List all projects in the workspace.",
592
-
make_schema [] []);
594
+
create
595
+
~name:"unpac_project_list"
596
+
~description:"List all projects in the workspace."
597
+
~input_schema:(schema_object [] ~required:[])
598
+
~handler:(fun _args -> project_list ~proc_mgr ~root ());
593
599
594
600
(* File operation tools *)
595
-
("read_file",
596
-
"Read the contents of a file. Use this to analyze source code, \
597
-
STATUS.md files, test files, etc.",
598
-
make_schema ["path"] [
599
-
("path", string_prop "Absolute or relative path to the file");
600
-
]);
601
+
create
602
+
~name:"read_file"
603
+
~description:"Read the contents of a file. Use this to analyze source code, \
604
+
STATUS.md files, test files, etc."
605
+
~input_schema:(schema_object [("path", schema_string)] ~required:["path"])
606
+
~handler:(fun args ->
607
+
match Claude.Tool_input.get_string args "path" with
608
+
| None -> err "Missing required parameter: path"
609
+
| Some path -> read_file ~fs ~path ());
601
610
602
-
("write_file",
603
-
"Write content to a file. Use this to update STATUS.md, fix code, \
604
-
add tests, etc. Parent directories are created if needed.",
605
-
make_schema ["path"; "content"] [
606
-
("path", string_prop "Path to write to");
607
-
("content", string_prop "Content to write");
608
-
]);
611
+
create
612
+
~name:"write_file"
613
+
~description:"Write content to a file. Use this to update STATUS.md, fix code, \
614
+
add tests, etc. Parent directories are created if needed."
615
+
~input_schema:(schema_object [
616
+
("path", schema_string);
617
+
("content", schema_string);
618
+
] ~required:["path"; "content"])
619
+
~handler:(fun args ->
620
+
match Claude.Tool_input.get_string args "path", Claude.Tool_input.get_string args "content" with
621
+
| None, _ -> err "Missing required parameter: path"
622
+
| _, None -> err "Missing required parameter: content"
623
+
| Some path, Some content -> write_file ~fs ~path ~content ());
609
624
610
-
("list_directory",
611
-
"List the contents of a directory.",
612
-
make_schema ["path"] [
613
-
("path", string_prop "Path to the directory");
614
-
]);
625
+
create
626
+
~name:"list_directory"
627
+
~description:"List the contents of a directory."
628
+
~input_schema:(schema_object [("path", schema_string)] ~required:["path"])
629
+
~handler:(fun args ->
630
+
match Claude.Tool_input.get_string args "path" with
631
+
| None -> err "Missing required parameter: path"
632
+
| Some path -> list_dir ~fs ~path ());
615
633
616
-
("glob_files",
617
-
"Find files matching a glob pattern. Supports *.ml, **/*.ml patterns.",
618
-
make_schema ["pattern"; "base_path"] [
619
-
("pattern", string_prop "Glob pattern (e.g., '*.ml', '**/*.mli')");
620
-
("base_path", string_prop "Base directory to search from");
621
-
]);
634
+
create
635
+
~name:"glob_files"
636
+
~description:"Find files matching a glob pattern. Supports *.ml, **/*.ml patterns."
637
+
~input_schema:(schema_object [
638
+
("pattern", schema_string);
639
+
("base_path", schema_string);
640
+
] ~required:["pattern"; "base_path"])
641
+
~handler:(fun args ->
642
+
match Claude.Tool_input.get_string args "pattern", Claude.Tool_input.get_string args "base_path" with
643
+
| None, _ -> err "Missing required parameter: pattern"
644
+
| _, None -> err "Missing required parameter: base_path"
645
+
| Some pattern, Some base_path -> glob_files ~fs ~pattern ~base_path ());
622
646
623
647
(* Shell execution *)
624
-
("run_shell",
625
-
"Execute a shell command. Use for building (dune build), testing \
626
-
(dune test), or other operations. Be careful with destructive commands.",
627
-
make_schema ["command"; "cwd"] [
628
-
("command", string_prop "Shell command to execute");
629
-
("cwd", string_prop "Working directory for the command");
630
-
("timeout_sec", int_prop "Timeout in seconds (default: 300)");
631
-
]);
648
+
create
649
+
~name:"run_shell"
650
+
~description:"Execute a shell command. Use for building (dune build), testing \
651
+
(dune test), or other operations. Be careful with destructive commands."
652
+
~input_schema:(schema_object [
653
+
("command", schema_string);
654
+
("cwd", schema_string);
655
+
] ~required:["command"; "cwd"])
656
+
~handler:(fun args ->
657
+
match Claude.Tool_input.get_string args "command", Claude.Tool_input.get_string args "cwd" with
658
+
| None, _ -> err "Missing required parameter: command"
659
+
| _, None -> err "Missing required parameter: cwd"
660
+
| Some command, Some cwd -> run_shell ~proc_mgr ~fs ~cwd ~command ());
632
661
633
662
(* Git commit *)
634
-
("git_commit",
635
-
"Stage all changes and create a git commit with the given message.",
636
-
make_schema ["cwd"; "message"] [
637
-
("cwd", string_prop "Working directory (should be a git repo)");
638
-
("message", string_prop "Commit message");
639
-
]);
640
-
]
641
-
642
-
(* Execute tool by name *)
643
-
let execute ~proc_mgr ~fs ~root ~tool_name ~(input : Jsont.json) =
644
-
Log.debug (fun m -> m "Executing tool: %s" tool_name);
663
+
create
664
+
~name:"git_commit"
665
+
~description:"Stage all changes and create a git commit with the given message."
666
+
~input_schema:(schema_object [
667
+
("cwd", schema_string);
668
+
("message", schema_string);
669
+
] ~required:["cwd"; "message"])
670
+
~handler:(fun args ->
671
+
match Claude.Tool_input.get_string args "cwd", Claude.Tool_input.get_string args "message" with
672
+
| None, _ -> err "Missing required parameter: cwd"
673
+
| _, None -> err "Missing required parameter: message"
674
+
| Some cwd, Some message ->
675
+
let cwd_path = Eio.Path.(fs / cwd) in
676
+
git_commit ~proc_mgr ~cwd:cwd_path ~message ());
677
+
] in
645
678
646
-
let get_string key =
647
-
match input with
648
-
| Jsont.Object (members, _) ->
649
-
let rec find = function
650
-
| [] -> None
651
-
| ((k, _meta), v) :: rest ->
652
-
if k = key then
653
-
match v with
654
-
| Jsont.String (s, _) -> Some s
655
-
| _ -> None
656
-
else find rest
657
-
in
658
-
find members
659
-
| _ -> None
660
-
in
661
-
662
-
let get_int key default =
663
-
match input with
664
-
| Jsont.Object (members, _) ->
665
-
let rec find = function
666
-
| [] -> default
667
-
| ((k, _meta), v) :: rest ->
668
-
if k = key then
669
-
match v with
670
-
| Jsont.Number (n, _) -> int_of_float n
671
-
| _ -> default
672
-
else find rest
673
-
in
674
-
find members
675
-
| _ -> default
676
-
in
677
-
678
-
match tool_name with
679
-
| "unpac_status" ->
680
-
status ~proc_mgr ~root
681
-
682
-
| "unpac_status_sync" ->
683
-
unpac_status_sync ~proc_mgr ~root
684
-
685
-
| "unpac_push" ->
686
-
(match get_string "remote" with
687
-
| None -> Error "Missing required parameter: remote"
688
-
| Some remote -> unpac_push ~proc_mgr ~root ~remote)
689
-
690
-
| "unpac_git_list" ->
691
-
git_list ~proc_mgr ~root
692
-
693
-
| "unpac_git_add" ->
694
-
(match get_string "url" with
695
-
| None -> Error "Missing required parameter: url"
696
-
| Some url ->
697
-
let name = get_string "name" in
698
-
let branch = get_string "branch" in
699
-
let subdir = get_string "subdir" in
700
-
git_add ~proc_mgr ~fs ~root ~url ?name ?branch ?subdir ())
701
-
702
-
| "unpac_git_info" ->
703
-
(match get_string "name" with
704
-
| None -> Error "Missing required parameter: name"
705
-
| Some name -> git_info ~proc_mgr ~root ~name)
706
-
707
-
| "unpac_git_diff" ->
708
-
(match get_string "name" with
709
-
| None -> Error "Missing required parameter: name"
710
-
| Some name -> git_diff ~proc_mgr ~root ~name)
711
-
712
-
| "unpac_opam_list" ->
713
-
opam_list ~proc_mgr ~root
714
-
715
-
| "unpac_project_list" ->
716
-
project_list ~proc_mgr ~root
717
-
718
-
| "read_file" ->
719
-
(match get_string "path" with
720
-
| None -> Error "Missing required parameter: path"
721
-
| Some path -> read_file ~fs ~path)
722
-
723
-
| "write_file" ->
724
-
(match get_string "path", get_string "content" with
725
-
| None, _ -> Error "Missing required parameter: path"
726
-
| _, None -> Error "Missing required parameter: content"
727
-
| Some path, Some content -> write_file ~fs ~path ~content)
728
-
729
-
| "list_directory" ->
730
-
(match get_string "path" with
731
-
| None -> Error "Missing required parameter: path"
732
-
| Some path -> list_dir ~fs ~path)
733
-
734
-
| "glob_files" ->
735
-
(match get_string "pattern", get_string "base_path" with
736
-
| None, _ -> Error "Missing required parameter: pattern"
737
-
| _, None -> Error "Missing required parameter: base_path"
738
-
| Some pattern, Some base_path -> glob_files ~fs ~pattern ~base_path)
739
-
740
-
| "run_shell" ->
741
-
(match get_string "command", get_string "cwd" with
742
-
| None, _ -> Error "Missing required parameter: command"
743
-
| _, None -> Error "Missing required parameter: cwd"
744
-
| Some command, Some cwd ->
745
-
let timeout_sec = get_int "timeout_sec" 300 in
746
-
run_shell ~proc_mgr ~fs ~cwd ~command ~timeout_sec)
747
-
748
-
| "git_commit" ->
749
-
(match get_string "cwd", get_string "message" with
750
-
| None, _ -> Error "Missing required parameter: cwd"
751
-
| _, None -> Error "Missing required parameter: message"
752
-
| Some cwd, Some message ->
753
-
let cwd_path = Eio.Path.(fs / cwd) in
754
-
git_commit ~proc_mgr ~cwd:cwd_path ~message)
755
-
756
-
| _ ->
757
-
Error (Printf.sprintf "Unknown tool: %s" tool_name)
679
+
Claude.Mcp_server.create ~name:"unpac" ~version:"1.0.0" ~tools ()
+32
-28
lib/claude/tools.mli
+32
-28
lib/claude/tools.mli
···
1
1
(** Tool definitions for Claude to interact with unpac.
2
2
3
-
These tools are exposed to Claude as function-calling tools,
4
-
allowing the agent to perform unpac operations autonomously. *)
3
+
Uses the Claude SDK's MCP-based custom tool architecture. All tools are
4
+
bundled into an in-process MCP server that gets registered with the
5
+
Claude client, making them available as mcp__unpac__<tool_name>.
5
6
6
-
(** {1 Tool Types} *)
7
+
{1 Available Tools}
7
8
8
-
type tool_result =
9
-
| Success of string
10
-
| Error of string
9
+
Workspace status:
10
+
- [unpac_status] - Overview of workspace (projects, git repos, opam packages)
11
+
- [unpac_status_sync] - Run 'unpac status' to update README.md
12
+
- [unpac_push] - Push all branches to remote
11
13
12
-
(** {1 Tool Execution} *)
14
+
Git vendoring:
15
+
- [unpac_git_list] - List vendored git repositories
16
+
- [unpac_git_add] - Vendor a new git repository
17
+
- [unpac_git_info] - Show details about a vendored repository
18
+
- [unpac_git_diff] - Show local changes in a vendored repository
13
19
14
-
val execute :
15
-
proc_mgr:Unpac.Git.proc_mgr ->
16
-
fs:Eio.Fs.dir_ty Eio.Path.t ->
17
-
root:Unpac.Worktree.root ->
18
-
tool_name:string ->
19
-
input:Jsont.json ->
20
-
tool_result
21
-
(** Execute a tool by name with the given JSON input. *)
20
+
Opam:
21
+
- [unpac_opam_list] - List vendored opam packages
22
+
- [unpac_project_list] - List projects
22
23
23
-
(** {1 Tool Schemas} *)
24
+
File operations:
25
+
- [read_file] - Read file contents
26
+
- [write_file] - Write content to a file
27
+
- [list_directory] - List directory contents
28
+
- [glob_files] - Find files matching a pattern
24
29
25
-
val tool_schemas : (string * string * Jsont.json) list
26
-
(** List of (name, description, input_schema) for all available tools. *)
30
+
Shell:
31
+
- [run_shell] - Execute a shell command
32
+
- [git_commit] - Stage and commit changes *)
27
33
28
-
(** {1 Individual Tools} *)
34
+
val create_mcp_server :
35
+
proc_mgr:Unpac.Git.proc_mgr ->
36
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
37
+
root:Unpac.Worktree.root ->
38
+
Claude.Mcp_server.t
39
+
(** Create an MCP server with all unpac tools.
29
40
30
-
val git_list : proc_mgr:Unpac.Git.proc_mgr -> root:Unpac.Worktree.root -> tool_result
31
-
val git_add : proc_mgr:Unpac.Git.proc_mgr -> fs:Eio.Fs.dir_ty Eio.Path.t ->
32
-
root:Unpac.Worktree.root -> url:string -> ?name:string ->
33
-
?branch:string -> ?subdir:string -> unit -> tool_result
34
-
val git_info : proc_mgr:Unpac.Git.proc_mgr -> root:Unpac.Worktree.root -> name:string -> tool_result
35
-
val git_diff : proc_mgr:Unpac.Git.proc_mgr -> root:Unpac.Worktree.root -> name:string -> tool_result
36
-
val opam_list : proc_mgr:Unpac.Git.proc_mgr -> root:Unpac.Worktree.root -> tool_result
37
-
val project_list : proc_mgr:Unpac.Git.proc_mgr -> root:Unpac.Worktree.root -> tool_result
38
-
val status : proc_mgr:Unpac.Git.proc_mgr -> root:Unpac.Worktree.root -> tool_result
41
+
The server is named "unpac" so tools are accessible as [mcp__unpac__<tool_name>].
42
+
Register it with [Claude.Options.with_mcp_server ~name:"unpac" server]. *)