Dasemu
40631362b3
Establishes version control for the personal Logseq DB fork before starting the server-client architecture migration and domain features described in docs/agent-guide and the approved implementation plan. Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2133 lines
74 KiB
OCaml
2133 lines
74 KiB
OCaml
type parsed = Parsed_bridge
|
|
|
|
type action =
|
|
| Agent_bridge of { repo : Cli_primitive.repo; graph : Cli_primitive.graph }
|
|
|
|
type routable_reason =
|
|
| Missing_stable_uuid
|
|
| Missing_task_tag
|
|
| Not_todo
|
|
| Assignee_mismatch
|
|
| Already_routed
|
|
|
|
type routable_decision = Routable | Not_routable of routable_reason
|
|
type template_kind = Task | Comment
|
|
|
|
type prompt_template = {
|
|
kind : template_kind;
|
|
body : string;
|
|
required_vars : string Rrbvec.t;
|
|
allowed_vars : string Rrbvec.t;
|
|
}
|
|
|
|
type bridge_result = {
|
|
mode : Cli_primitive.keyword;
|
|
graph : Cli_primitive.graph;
|
|
agent_name : string;
|
|
routed : Melange_edn_melange.any Rrbvec.t;
|
|
}
|
|
|
|
type routed_task = { block : Melange_edn_melange.any; session : string option }
|
|
type prompt_templates = { task : string; comment : string }
|
|
type inherited_session = { parent_block_uuid : string; session_id : string }
|
|
|
|
let routed_blocks : (string, unit) Hashtbl.t = Hashtbl.create 32
|
|
|
|
let claim_routing_block uuid =
|
|
if Hashtbl.mem routed_blocks uuid then false
|
|
else (
|
|
Hashtbl.add routed_blocks uuid ();
|
|
true)
|
|
|
|
let default_master_prompt =
|
|
String.concat "\n"
|
|
[
|
|
"# AgentBridge Master Agent";
|
|
"";
|
|
"## Role";
|
|
"You are the graph-scoped master agent for Logseq AgentBridge.";
|
|
"Classify incoming work and decide how to dispatch subagents.";
|
|
"";
|
|
"## Graph Safety";
|
|
"Do not operate outside the target graph.";
|
|
"Only the master agent may write task results back into the target graph.";
|
|
"Subagents may read graph context but must not write graph content.";
|
|
"When dispatching a subagent for a task, write the subagent Codex \
|
|
session id to the task block's `:logseq.property.agent/session-id` \
|
|
property.";
|
|
]
|
|
|
|
let graph_scope_line = "Do not operate outside the target graph."
|
|
let task_result_line = "Write task results back into the graph."
|
|
|
|
let task_finish_reaction_line =
|
|
"When the task or subagent finishes, remove the `eyes` reaction from the \
|
|
task block whether it succeeded or failed."
|
|
|
|
let comment_completion_line = "Complete the request from the mentioned comment."
|
|
|
|
let graph_report_lines =
|
|
Vec.of_array
|
|
[|
|
|
"If the target graph is sync-enabled, make sure it is synced after \
|
|
writing back to the graph.";
|
|
"Keep the report short when possible.";
|
|
"Report blockers only if there is a blocker.";
|
|
"Report root cause and Steps to verify only for bug fixes.";
|
|
|]
|
|
|
|
let comment_reply_instruction_lines =
|
|
Vec.of_array
|
|
[|
|
|
"Reply instructions:";
|
|
"For a short reply, append a comment after the requesting comment.";
|
|
"For a long reply, write a normal block tree after the comments area and \
|
|
append a comment that references that tree.";
|
|
"When referencing result blocks in DB graphs, reference result blocks \
|
|
with [[block-uuid]], not ((block-uuid)).";
|
|
"If the request is blocked or fails, make that clear in the reply.";
|
|
|]
|
|
|
|
let default_task_prompt_template =
|
|
Vec.string_concat "\n"
|
|
( Vec.of_array
|
|
[|
|
|
"You are handling a Logseq AgentBridge task.";
|
|
"";
|
|
"Graph: {{graph}}";
|
|
"Block UUID: {{block-uuid}}";
|
|
"AgentBridge name: {{agent-name}}";
|
|
"";
|
|
graph_scope_line;
|
|
task_result_line;
|
|
task_finish_reaction_line;
|
|
|]
|
|
|> fun lines ->
|
|
Vec.append lines graph_report_lines |> fun lines ->
|
|
Vec.append_array lines [| ""; "Task block tree:"; "{{task-block-tree}}" |]
|
|
)
|
|
|
|
let default_comment_prompt_template =
|
|
Vec.string_concat "\n"
|
|
( Vec.of_array
|
|
[|
|
|
"You are handling a Logseq AgentBridge comment request.";
|
|
"";
|
|
"Graph: {{graph}}";
|
|
"Comment UUID: {{comment-uuid}}";
|
|
"AgentBridge name: {{agent-name}}";
|
|
"";
|
|
graph_scope_line;
|
|
comment_completion_line;
|
|
|]
|
|
|> fun lines ->
|
|
Vec.append lines graph_report_lines |> fun lines ->
|
|
Vec.append_array lines
|
|
[|
|
|
"";
|
|
"Comment target context:";
|
|
"{{comment-target-context}}";
|
|
"";
|
|
"Comment thread context:";
|
|
"{{comment-thread-context}}";
|
|
"";
|
|
"Requesting comment:";
|
|
"{{requesting-comment}}";
|
|
"";
|
|
|]
|
|
|> fun lines -> Vec.append lines comment_reply_instruction_lines )
|
|
|
|
let trim_non_empty value =
|
|
let value = String.trim value in
|
|
if value = "" then None else Some value
|
|
|
|
let strip_keyword_prefix value =
|
|
if String.length value > 0 && value.[0] = ':' then
|
|
String.sub value 1 (String.length value - 1)
|
|
else value
|
|
|
|
let value_key_matches key value =
|
|
let key = strip_keyword_prefix key in
|
|
match Edn_util.as_string_like value with
|
|
| Some k -> strip_keyword_prefix k = key
|
|
| None -> false
|
|
|
|
let map_contains key value =
|
|
match Edn_util.as_map value with
|
|
| Some fields -> Vec.exists (fun (k, _) -> value_key_matches key k) fields
|
|
| None -> false
|
|
|
|
let resolve_agent_name config hostname =
|
|
let configured =
|
|
Option.bind config.Cli_config.raw_file_config (fun value ->
|
|
Edn_util.get_string value "agent-name")
|
|
in
|
|
let configured_present =
|
|
match config.raw_file_config with
|
|
| Some value -> map_contains "agent-name" value
|
|
| None -> false
|
|
in
|
|
match (configured_present, Option.bind configured trim_non_empty) with
|
|
| true, Some agent_name -> Ok agent_name
|
|
| true, None ->
|
|
Error
|
|
(Error.make Error.Agent_name_invalid
|
|
"agent-name in cli.edn must be a non-empty string")
|
|
| false, _ -> (
|
|
match Option.bind hostname trim_non_empty with
|
|
| Some agent_name -> Ok agent_name
|
|
| None -> (
|
|
match trim_non_empty (Cli_platform.hostname ()) with
|
|
| Some agent_name -> Ok agent_name
|
|
| None ->
|
|
Error
|
|
(Error.make Error.Agent_name_invalid
|
|
"agent-name cannot be resolved from cli.edn or hostname")))
|
|
|
|
let value_list = function
|
|
| Some value -> Option.value (Edn_util.as_seq value) ~default:Vec.empty
|
|
| _ -> Vec.empty
|
|
|
|
let ident_value value =
|
|
match Edn_util.as_string_like value with
|
|
| Some ident -> Some (strip_keyword_prefix ident)
|
|
| None ->
|
|
if Option.is_some (Edn_util.as_map value) then
|
|
Option.map strip_keyword_prefix (Edn_util.get_string value "db/ident")
|
|
else None
|
|
|
|
let has_task_tag raw =
|
|
value_list (Edn_util.get raw "block/tags")
|
|
|> Vec.exists (fun tag -> ident_value tag = Some "logseq.class/Task")
|
|
|
|
let status_ident raw =
|
|
match Edn_util.get raw "logseq.property/status" with
|
|
| Some value -> ident_value value
|
|
| None -> None
|
|
|
|
let assignee_values raw =
|
|
value_list (Edn_util.get raw "logseq.property/assignee")
|
|
|> Vec.filter_map (fun value ->
|
|
Option.bind (Edn_util.get_string value "block/title") trim_non_empty)
|
|
|
|
let routable_task_decision entity ~agent_name =
|
|
let raw = entity.Entity.raw in
|
|
if Option.is_none (Edn_util.get raw "block/uuid") then
|
|
Not_routable Missing_stable_uuid
|
|
else if not (has_task_tag raw) then Not_routable Missing_task_tag
|
|
else if status_ident raw <> Some "logseq.property/status.todo" then
|
|
Not_routable Not_todo
|
|
else if not (Vec.mem agent_name (assignee_values raw)) then
|
|
Not_routable Assignee_mismatch
|
|
else if Option.is_some (Edn_util.get raw "logseq.property.agent/session-id")
|
|
then Not_routable Already_routed
|
|
else Routable
|
|
|
|
let is_var_char = function
|
|
| 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '-' -> true
|
|
| _ -> false
|
|
|
|
let valid_var_name value =
|
|
String.length value > 0 && String.for_all is_var_char value
|
|
|
|
let unique values =
|
|
let rec loop seen remaining =
|
|
match Vec.pop_front remaining with
|
|
| None -> seen
|
|
| Some (value, rest) when Vec.mem value seen -> loop seen rest
|
|
| Some (value, rest) -> loop (Vec.push_back seen value) rest
|
|
in
|
|
loop Vec.empty values
|
|
|
|
let template_vars body =
|
|
let len = String.length body in
|
|
let rec loop acc index =
|
|
if index + 3 >= len then unique acc
|
|
else if body.[index] = '{' && body.[index + 1] = '{' then
|
|
match String.index_from_opt body (index + 2) '}' with
|
|
| Some close when close + 1 < len && body.[close + 1] = '}' ->
|
|
let name = String.sub body (index + 2) (close - index - 2) in
|
|
let quoted =
|
|
index > 0
|
|
&& body.[index - 1] = '\''
|
|
&& close + 2 < len
|
|
&& body.[close + 2] = '\''
|
|
in
|
|
let acc =
|
|
if (not quoted) && valid_var_name name then Vec.push_back acc name
|
|
else acc
|
|
in
|
|
loop acc (close + 2)
|
|
| _ -> loop acc (index + 2)
|
|
else loop acc (index + 1)
|
|
in
|
|
loop Vec.empty 0
|
|
|
|
let list_diff xs ys = Vec.filter (fun x -> not (Vec.mem x ys)) xs
|
|
|
|
let validate_prompt_template template =
|
|
if String.trim template.body = "" then
|
|
Error
|
|
(Error.make Error.Missing_template_code_block
|
|
"agent bridge prompt template code block is missing")
|
|
else
|
|
let vars = template_vars template.body in
|
|
let unknown_vars = list_diff vars template.allowed_vars in
|
|
if not (Vec.is_empty unknown_vars) then
|
|
Error
|
|
(Error.make Error.Unknown_template_vars
|
|
"agent bridge prompt template has unknown variables")
|
|
else
|
|
let missing_vars = list_diff template.required_vars vars in
|
|
if not (Vec.is_empty missing_vars) then
|
|
Error
|
|
(Error.make Error.Missing_template_vars
|
|
"agent bridge prompt template is missing required variables")
|
|
else Ok ()
|
|
|
|
let raw_config_string config key =
|
|
Option.bind config.Cli_config.raw_file_config (fun value ->
|
|
Edn_util.get_string value key)
|
|
|
|
let raw_config_bool config key =
|
|
Option.bind config.Cli_config.raw_file_config (fun value ->
|
|
Edn_util.get_bool value key)
|
|
|
|
let codex_bin config =
|
|
Option.value (raw_config_string config "codex-bin") ~default:"codex"
|
|
|
|
let agent_bridge_process_once config =
|
|
Option.value
|
|
(raw_config_bool config "agent-bridge-process-once?")
|
|
~default:false
|
|
|
|
let codex_command_prefix config =
|
|
Vec.of_array [| codex_bin config; "--sandbox"; "danger-full-access"; "exec" |]
|
|
|
|
let build_codex_command config prompt =
|
|
Vec.append_array
|
|
(codex_command_prefix config)
|
|
[| "--json"; "--skip-git-repo-check"; prompt |]
|
|
|
|
let build_codex_resume_command config session_id prompt =
|
|
Vec.append_array
|
|
(codex_command_prefix config)
|
|
[| "resume"; "--json"; "--skip-git-repo-check"; session_id; prompt |]
|
|
|
|
let shell_env () = Cli_unix.environment ()
|
|
|
|
let run_command_capture command =
|
|
match Vec.pop_front command with
|
|
| None -> { Cli_unix.status = 1; stdout = ""; stderr = "missing command" }
|
|
| Some (bin, args) -> Cli_unix.run_process_capture bin args (shell_env ())
|
|
|
|
let start_command_capture_session_line command =
|
|
match Vec.pop_front command with
|
|
| None -> { Cli_unix.status = 1; stdout = ""; stderr = "missing command" }
|
|
| Some (bin, args) ->
|
|
Cli_unix.start_process_capture_session_line bin args (shell_env ())
|
|
|
|
let start_command_detached command =
|
|
match Vec.peek_front_opt command with
|
|
| None -> Error (Error.make Error.Codex_start_failed "missing command")
|
|
| Some bin -> (
|
|
try
|
|
ignore
|
|
(Cli_unix.create_process_env bin (Vec.to_array command) (shell_env ())
|
|
0 1 2);
|
|
Ok ()
|
|
with
|
|
| Cli_unix.Cli_unix_error (_, op, detail) ->
|
|
Error
|
|
(Error.make Error.Codex_start_failed
|
|
("failed to start codex " ^ op ^ ": " ^ detail))
|
|
| exn ->
|
|
Error
|
|
(Error.make Error.Codex_start_failed
|
|
("failed to start codex: " ^ Printexc.to_string exn)))
|
|
|
|
let codex_available config =
|
|
let result =
|
|
run_command_capture (Vec.of_array [| codex_bin config; "--version" |])
|
|
in
|
|
result.Cli_unix.status = 0
|
|
|
|
let parse_codex_session_id stdout =
|
|
Vec.split_on_char '\n' stdout
|
|
|> Vec.find_map (fun line ->
|
|
try
|
|
match Json_util.object_of_json_string line with
|
|
| None -> None
|
|
| Some object_ -> (
|
|
match
|
|
Vec.of_array
|
|
[| "session-id"; "session_id"; "thread-id"; "thread_id" |]
|
|
|> Vec.find_map (Json_util.string_field object_)
|
|
with
|
|
| Some session_id -> Some session_id
|
|
| None ->
|
|
Vec.of_array
|
|
[|
|
|
("session", "id");
|
|
("session", "session-id");
|
|
("session", "session_id");
|
|
("thread", "id");
|
|
("thread", "thread-id");
|
|
("thread", "thread_id");
|
|
|]
|
|
|> Vec.find_map (fun (object_field, nested_field) ->
|
|
Json_util.nested_string_field object_ object_field
|
|
nested_field))
|
|
with _ -> None)
|
|
|
|
let start_codex _config command =
|
|
let result = start_command_capture_session_line command in
|
|
if result.Cli_unix.status <> 0 then
|
|
Error
|
|
(Error.make Error.Codex_start_failed
|
|
("codex exited before startup completed: " ^ result.Cli_unix.stderr))
|
|
else
|
|
match parse_codex_session_id result.Cli_unix.stdout with
|
|
| Some session when String.trim session <> "" -> Ok session
|
|
| _ ->
|
|
Error
|
|
(Error.make Error.Codex_session_id_missing
|
|
"codex exited before reporting a session id")
|
|
|
|
let ensure_master_session config master_prompt =
|
|
start_codex config (build_codex_command config master_prompt)
|
|
|
|
let resume_master_session config master_session prompt =
|
|
match
|
|
start_command_detached
|
|
(build_codex_resume_command config master_session prompt)
|
|
with
|
|
| Ok () -> Ok master_session
|
|
| Error err -> Error err
|
|
|
|
let block_uuid value = Edn_util.get_string value "block/uuid"
|
|
|
|
let block_title value =
|
|
Option.value (Edn_util.get_string value "block/title") ~default:""
|
|
|
|
let project_dir_line config =
|
|
match config.Cli_config.project_dir with
|
|
| Some value when String.trim value <> "" ->
|
|
Vec.singleton ("Project directory: " ^ value)
|
|
| _ -> Vec.empty
|
|
|
|
let inherited_task_session_lines = function
|
|
| None -> Vec.empty
|
|
| Some inherited ->
|
|
Vec.of_array
|
|
[|
|
|
"";
|
|
"Inherited parent task UUID: " ^ inherited.parent_block_uuid;
|
|
"Inherited subagent session id: " ^ inherited.session_id;
|
|
"Continue this child task in the inherited subagent session instead \
|
|
of launching a new subagent.";
|
|
|]
|
|
|
|
let build_master_task_dispatch_prompt config ~graph ~agent_name
|
|
?inherited_session ?tree_text block =
|
|
let uuid = Option.value (block_uuid block) ~default:"" in
|
|
Vec.string_concat "\n"
|
|
( Vec.of_array
|
|
[|
|
|
"You are handling a Logseq AgentBridge master dispatch request.";
|
|
"";
|
|
"Request kind: task";
|
|
"Graph: " ^ graph;
|
|
"AgentBridge name: " ^ agent_name;
|
|
|]
|
|
|> fun lines ->
|
|
Vec.append lines (project_dir_line config) |> fun lines ->
|
|
Vec.append_array lines
|
|
[|
|
|
"";
|
|
graph_scope_line;
|
|
"Only the master agent may write task results back into the target \
|
|
graph.";
|
|
"Subagents may read graph context but must not write graph content.";
|
|
"Route this request according to the master prompt policy.";
|
|
"After launching the subagent with `codex exec`, write that subagent \
|
|
session id to the task block's `:logseq.property.agent/session-id` \
|
|
property.";
|
|
"";
|
|
"Write task results back into the graph.";
|
|
task_finish_reaction_line;
|
|
|]
|
|
|> fun lines ->
|
|
Vec.append lines graph_report_lines |> fun lines ->
|
|
Vec.append_array lines [| ""; "Block UUID: " ^ uuid; "" |] |> fun lines ->
|
|
Vec.append lines (inherited_task_session_lines inherited_session)
|
|
|> fun lines ->
|
|
Vec.append_array lines
|
|
[|
|
|
"";
|
|
"Task block tree:";
|
|
Option.value tree_text ~default:(block_title block);
|
|
|] )
|
|
|
|
let dispatch_task_to_master config ~graph ~agent_name ~master_session
|
|
?inherited_session ?tree_text block =
|
|
let prompt =
|
|
build_master_task_dispatch_prompt config ~graph ~agent_name
|
|
?inherited_session ?tree_text block
|
|
in
|
|
resume_master_session config master_session prompt
|
|
|
|
let build_master_comment_dispatch_prompt config ~graph ~agent_name
|
|
~comment_block ~target_tree_texts ~comments_area_tree_text
|
|
~comment_tree_text =
|
|
let uuid = Option.value (block_uuid comment_block) ~default:"" in
|
|
Vec.string_concat "\n"
|
|
( Vec.of_array
|
|
[|
|
|
"You are handling a Logseq AgentBridge master dispatch request.";
|
|
"";
|
|
"Request kind: comment";
|
|
"Graph: " ^ graph;
|
|
"AgentBridge name: " ^ agent_name;
|
|
|]
|
|
|> fun lines ->
|
|
Vec.append lines (project_dir_line config) |> fun lines ->
|
|
Vec.append_array lines [| ""; graph_scope_line; comment_completion_line |]
|
|
|> fun lines ->
|
|
Vec.append lines graph_report_lines |> fun lines ->
|
|
Vec.push_back lines "" |> fun lines ->
|
|
Vec.append lines comment_reply_instruction_lines |> fun lines ->
|
|
Vec.append_array lines
|
|
[|
|
|
"";
|
|
"Comment UUID: " ^ uuid;
|
|
"";
|
|
"Comment target context:";
|
|
Vec.string_concat "\n"
|
|
(Vec.filter
|
|
(fun value -> String.trim value <> "")
|
|
target_tree_texts);
|
|
"";
|
|
"Comment thread context:";
|
|
comments_area_tree_text;
|
|
"";
|
|
"Requesting comment:";
|
|
comment_tree_text;
|
|
|] )
|
|
|
|
let dispatch_comment_to_master config ~graph ~agent_name ~master_session
|
|
~target_tree_texts ~comments_area_tree_text ~comment_tree_text comment_block
|
|
=
|
|
let prompt =
|
|
build_master_comment_dispatch_prompt config ~graph ~agent_name
|
|
~comment_block ~target_tree_texts ~comments_area_tree_text
|
|
~comment_tree_text
|
|
in
|
|
resume_master_session config master_session prompt
|
|
|
|
let command_id _ = Command_id.Agent_bridge
|
|
let validate_parsed _ = Ok ()
|
|
|
|
let build ?registry:_ config _globals = function
|
|
| Parsed_bridge -> (
|
|
match config.Cli_config.repo with
|
|
| Some repo ->
|
|
Ok (Agent_bridge { repo; graph = Cli_config.repo_to_graph repo })
|
|
| None -> Error (Error.missing_repo "repo is required for agent bridge"))
|
|
|
|
let kw value = Edn_util.keyword value
|
|
let sym value = Edn_util.symbol value
|
|
let vector_vec values = Edn_util.vector_vec values
|
|
let list_vec values = Edn_util.list_vec values
|
|
let where_v values = Cli_primitive.V (Edn_util.vector_t_vec values)
|
|
let where_l values = Cli_primitive.L (Edn_util.list_t_vec values)
|
|
|
|
let query_value query =
|
|
Edn_util.any (Cli_primitive.datascript_query_to_edn query)
|
|
|
|
let query_call query args =
|
|
Edn_util.vector_vec (Vec.push_front args (query_value query))
|
|
|
|
let empty_rules = Edn_util.vector_vec Vec.empty
|
|
let agent_bridge_registry_page = "AgentBridge"
|
|
let master_prompt_wrapper_title = "AgentBridge master prompt"
|
|
let task_prompt_template_title = "Task prompt template"
|
|
let comment_prompt_template_title = "Comment prompt template"
|
|
|
|
let page_name_sanity_lc value =
|
|
value |> String.trim |> String.lowercase_ascii |> String.to_seq
|
|
|> Seq.filter (function ' ' | '\t' | '\n' | '\r' -> false | _ -> true)
|
|
|> String.of_seq
|
|
|
|
let registry_page_name () = page_name_sanity_lc agent_bridge_registry_page
|
|
let agent_page_name agent_name = page_name_sanity_lc agent_name
|
|
|
|
let live_entity value =
|
|
Option.is_some (Edn_util.get value "db/id")
|
|
&& Option.is_none (Edn_util.get value "logseq.property/deleted-at")
|
|
|
|
let first_live_entity values = Vec.find_opt live_entity values
|
|
|
|
let order_key value =
|
|
match Edn_util.get value "block/order" with
|
|
| Some value -> (
|
|
match (Edn_util.as_string value, Edn_util.as_int value) with
|
|
| Some text, _ -> text
|
|
| _, Some order -> string_of_int order
|
|
| _ -> "")
|
|
| None -> ""
|
|
|
|
let child_blocks block =
|
|
let values =
|
|
match
|
|
(Edn_util.get block "block/children", Edn_util.get block "block/_parent")
|
|
with
|
|
| Some value, _ | None, Some value ->
|
|
Option.value (Edn_util.as_seq value) ~default:Vec.empty
|
|
| None, None -> Vec.empty
|
|
in
|
|
values |> Vec.filter live_entity
|
|
|> Vec.sort (fun a b -> String.compare (order_key a) (order_key b))
|
|
|
|
let rec block_title_tree block =
|
|
let title =
|
|
Option.value (Edn_util.get_string block "block/title") ~default:""
|
|
in
|
|
Vec.push_front (Vec.concat_map block_title_tree (child_blocks block)) title
|
|
|
|
let code_block_tag tag = ident_value tag = Some "logseq.class/Code-block"
|
|
|
|
let block_has_code_tag block =
|
|
value_list (Edn_util.get block "block/tags") |> Vec.exists code_block_tag
|
|
|
|
let extract_code_blocks text =
|
|
let len = String.length text in
|
|
let rec loop acc index =
|
|
if index + 3 > len then acc
|
|
else if index + 3 <= len && String.sub text index 3 = "```" then
|
|
match String.index_from_opt text (index + 3) '\n' with
|
|
| None -> loop acc (index + 3)
|
|
| Some body_start -> (
|
|
let rec find_close i =
|
|
if i + 3 > len then None
|
|
else if String.sub text i 3 = "```" then Some i
|
|
else find_close (i + 1)
|
|
in
|
|
match find_close (body_start + 1) with
|
|
| None -> loop acc (body_start + 1)
|
|
| Some close ->
|
|
let body =
|
|
String.sub text (body_start + 1) (close - body_start - 1)
|
|
in
|
|
loop (Vec.push_back acc body) (close + 3))
|
|
else loop acc (index + 1)
|
|
in
|
|
loop Vec.empty 0
|
|
|
|
let task_prompt_template body =
|
|
{
|
|
kind = Task;
|
|
body;
|
|
required_vars =
|
|
Vec.of_array [| "graph"; "block-uuid"; "agent-name"; "task-block-tree" |];
|
|
allowed_vars =
|
|
Vec.of_array [| "graph"; "block-uuid"; "agent-name"; "task-block-tree" |];
|
|
}
|
|
|
|
let comment_prompt_template body =
|
|
{
|
|
kind = Comment;
|
|
body;
|
|
required_vars =
|
|
Vec.of_array
|
|
[|
|
|
"graph";
|
|
"comment-uuid";
|
|
"agent-name";
|
|
"comment-target-context";
|
|
"comment-thread-context";
|
|
"requesting-comment";
|
|
|];
|
|
allowed_vars =
|
|
Vec.of_array
|
|
[|
|
|
"graph";
|
|
"comment-uuid";
|
|
"agent-name";
|
|
"comment-target-context";
|
|
"comment-thread-context";
|
|
"requesting-comment";
|
|
|];
|
|
}
|
|
|
|
let prompt_template_for_kind = function
|
|
| Task -> task_prompt_template
|
|
| Comment -> comment_prompt_template
|
|
|
|
let prompt_template_title = function
|
|
| Task -> task_prompt_template_title
|
|
| Comment -> comment_prompt_template_title
|
|
|
|
let default_prompt_template = function
|
|
| Task -> default_task_prompt_template
|
|
| Comment -> default_comment_prompt_template
|
|
|
|
let prompt_template_from_block kind block =
|
|
let templates =
|
|
block_title_tree block |> Vec.concat_map extract_code_blocks
|
|
in
|
|
let renderable =
|
|
templates
|
|
|> Vec.filter (fun body ->
|
|
validate_prompt_template ((prompt_template_for_kind kind) body) = Ok ())
|
|
in
|
|
if Vec.length renderable = 1 then Ok (Vec.peek_front renderable)
|
|
else
|
|
match templates with
|
|
| templates when Vec.length templates = 1 -> (
|
|
let body = Vec.peek_front templates in
|
|
match
|
|
validate_prompt_template ((prompt_template_for_kind kind) body)
|
|
with
|
|
| Ok () -> Ok body
|
|
| Error err -> Error err)
|
|
| _ ->
|
|
Error
|
|
(Error.make Error.Agent_prompt_template_invalid
|
|
"agent bridge prompt template must contain one code block")
|
|
|
|
let blocks_by_title blocks title =
|
|
Vec.find_opt
|
|
(fun block -> Edn_util.get_string block "block/title" = Some title)
|
|
blocks
|
|
|
|
let agent_bridge_registry_page_query =
|
|
query_call
|
|
(Cli_primitive.make_datascript_query
|
|
~find:
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
list_vec
|
|
(Vec.of_array
|
|
[|
|
|
sym "pull";
|
|
sym "?p";
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/name";
|
|
kw "block/title";
|
|
kw "logseq.property/deleted-at";
|
|
|]);
|
|
|]);
|
|
sym "...";
|
|
|]);
|
|
|])
|
|
~in_:
|
|
(Vec.of_array
|
|
[|
|
|
Melange_edn_melange.symbol "$";
|
|
Melange_edn_melange.symbol "?page-name";
|
|
|])
|
|
~where:
|
|
(Vec.singleton
|
|
(where_v
|
|
(Vec.of_array [| sym "?p"; kw "block/name"; sym "?page-name" |])))
|
|
())
|
|
(Vec.singleton (Edn_util.string (registry_page_name ())))
|
|
|
|
let registered_agent_query agent_name =
|
|
query_call
|
|
(Cli_primitive.make_datascript_query
|
|
~find:
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
list_vec
|
|
(Vec.of_array
|
|
[|
|
|
sym "pull";
|
|
sym "?p";
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/name";
|
|
kw "block/title";
|
|
kw "logseq.property/deleted-at";
|
|
|]);
|
|
|]);
|
|
sym "...";
|
|
|]);
|
|
|])
|
|
~in_:
|
|
(Vec.of_array
|
|
[|
|
|
Melange_edn_melange.symbol "$";
|
|
Melange_edn_melange.symbol "?agent-page-name";
|
|
|])
|
|
~where:
|
|
(Vec.of_array
|
|
[|
|
|
where_v
|
|
(Vec.of_array
|
|
[| sym "?p"; kw "block/name"; sym "?agent-page-name" |]);
|
|
|])
|
|
())
|
|
(Vec.singleton (Edn_util.string (agent_page_name agent_name)))
|
|
|
|
let agent_master_prompt_blocks_query page_id =
|
|
query_call
|
|
(Cli_primitive.make_datascript_query
|
|
~find:
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
list_vec
|
|
(Vec.of_array
|
|
[|
|
|
sym "pull";
|
|
sym "?b";
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/title";
|
|
kw "block/order";
|
|
kw "logseq.property/deleted-at";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "block/_parent",
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/title";
|
|
kw "block/order";
|
|
kw
|
|
"logseq.property/deleted-at";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "block/tags",
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "db/ident";
|
|
kw
|
|
"block/name";
|
|
kw
|
|
"block/title";
|
|
|]) );
|
|
|]);
|
|
|]) );
|
|
|]);
|
|
|]);
|
|
|]);
|
|
sym "...";
|
|
|]);
|
|
|])
|
|
~in_:
|
|
(Vec.of_array
|
|
[|
|
|
Melange_edn_melange.symbol "$";
|
|
Melange_edn_melange.symbol "?page-id";
|
|
|])
|
|
~where:
|
|
(Vec.singleton
|
|
(where_v
|
|
(Vec.of_array [| sym "?b"; kw "block/parent"; sym "?page-id" |])))
|
|
())
|
|
(Vec.singleton (Edn_util.int64 page_id))
|
|
|
|
let prompt_template_blocks_query page_id =
|
|
query_call
|
|
(Cli_primitive.make_datascript_query
|
|
~find:
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
list_vec
|
|
(Vec.of_array
|
|
[|
|
|
sym "pull";
|
|
sym "?b";
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/title";
|
|
kw "block/order";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "block/_parent",
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/title";
|
|
kw "block/order";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "block/_parent",
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw
|
|
"block/uuid";
|
|
kw
|
|
"block/title";
|
|
kw
|
|
"block/order";
|
|
|]) );
|
|
|]);
|
|
|]) );
|
|
|]);
|
|
|]);
|
|
|]);
|
|
sym "...";
|
|
|]);
|
|
|])
|
|
~in_:
|
|
(Vec.of_array
|
|
[|
|
|
Melange_edn_melange.symbol "$";
|
|
Melange_edn_melange.symbol "?page-id";
|
|
|])
|
|
~where:
|
|
(Vec.singleton
|
|
(where_v
|
|
(Vec.of_array [| sym "?b"; kw "block/parent"; sym "?page-id" |])))
|
|
())
|
|
(Vec.singleton (Edn_util.int64 page_id))
|
|
|
|
let task_ancestor_session_selector =
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/title";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "block/tags",
|
|
vector_vec
|
|
(Vec.of_array [| kw "db/ident"; kw "block/title" |]) );
|
|
|]);
|
|
kw "logseq.property.agent/session-id";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
(kw "block/parent", vector_vec (Vec.of_array [| kw "db/id" |]));
|
|
|]);
|
|
|])
|
|
|
|
let routable_task_selector =
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/title";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "block/tags",
|
|
vector_vec
|
|
(Vec.of_array [| kw "db/ident"; kw "block/title" |]) );
|
|
|]);
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "logseq.property/status",
|
|
vector_vec
|
|
(Vec.of_array [| kw "db/ident"; kw "block/title" |]) );
|
|
|]);
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "logseq.property/assignee",
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/title";
|
|
kw "block/name";
|
|
kw "db/ident";
|
|
|]) );
|
|
|]);
|
|
kw "logseq.property.agent/session-id";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
(kw "block/parent", vector_vec (Vec.of_array [| kw "db/id" |]));
|
|
|]);
|
|
|])
|
|
|
|
let routable_task_query agent_name =
|
|
query_call
|
|
(Cli_primitive.make_datascript_query
|
|
~find:
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
list_vec
|
|
(Vec.of_array
|
|
[| sym "pull"; sym "?e"; routable_task_selector |]);
|
|
sym "...";
|
|
|]);
|
|
|])
|
|
~in_:
|
|
(Vec.of_array
|
|
[|
|
|
Melange_edn_melange.symbol "$";
|
|
Melange_edn_melange.symbol "?agent-name";
|
|
Melange_edn_melange.symbol "%";
|
|
|])
|
|
~where:
|
|
(Vec.of_array
|
|
[|
|
|
where_v
|
|
(Vec.of_array
|
|
[| sym "?e"; kw "block/tags"; kw "logseq.class/Task" |]);
|
|
where_v
|
|
(Vec.of_array
|
|
[| sym "?e"; kw "logseq.property/status"; sym "?status" |]);
|
|
where_v
|
|
(Vec.of_array
|
|
[|
|
|
sym "?status";
|
|
kw "db/ident";
|
|
kw "logseq.property/status.todo";
|
|
|]);
|
|
where_v
|
|
(Vec.of_array
|
|
[|
|
|
sym "?assignee-property";
|
|
kw "block/name";
|
|
Edn_util.string "assignee";
|
|
|]);
|
|
where_v
|
|
(Vec.of_array
|
|
[|
|
|
sym "?assignee-property";
|
|
kw "db/ident";
|
|
sym "?assignee-attr";
|
|
|]);
|
|
where_v
|
|
(Vec.of_array
|
|
[| sym "?e"; sym "?assignee-attr"; sym "?assignee-ref" |]);
|
|
where_v
|
|
(Vec.of_array
|
|
[|
|
|
sym "?assignee-ref"; kw "block/title"; sym "?agent-name";
|
|
|]);
|
|
|])
|
|
())
|
|
(Vec.of_array [| Edn_util.string agent_name; empty_rules |])
|
|
|
|
let comment_block_selector =
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/title";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "block/tags",
|
|
vector_vec
|
|
(Vec.of_array [| kw "db/ident"; kw "block/title" |]) );
|
|
|]);
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "block/refs",
|
|
vector_vec
|
|
(Vec.of_array
|
|
[| kw "db/id"; kw "block/title"; kw "block/name" |]) );
|
|
|]);
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "block/parent",
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/title";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "block/tags",
|
|
vector_vec
|
|
(Vec.of_array
|
|
[| kw "db/ident"; kw "block/title" |]) );
|
|
|]);
|
|
|]) );
|
|
|]);
|
|
sym "*";
|
|
|])
|
|
|
|
let comment_target_block_selector =
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/title";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "logseq.property/assignee",
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/title";
|
|
kw "block/name";
|
|
kw "db/ident";
|
|
|]) );
|
|
|]);
|
|
kw "logseq.property.agent/session-id";
|
|
sym "*";
|
|
|])
|
|
|
|
let comments_area_selector =
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "db/id";
|
|
kw "block/uuid";
|
|
kw "block/title";
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "block/tags",
|
|
vector_vec
|
|
(Vec.of_array [| kw "db/ident"; kw "block/title" |]) );
|
|
|]);
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
( kw "logseq.property.comments/blocks",
|
|
comment_target_block_selector );
|
|
|]);
|
|
|])
|
|
|
|
let reaction_query target_uuid emoji_id =
|
|
query_call
|
|
(Cli_primitive.make_datascript_query
|
|
~find:(Vec.of_array [| sym "?r"; sym "." |])
|
|
~in_:
|
|
(Vec.of_array
|
|
[|
|
|
Melange_edn_melange.symbol "$";
|
|
Melange_edn_melange.symbol "?target-uuid";
|
|
Melange_edn_melange.symbol "?emoji-id";
|
|
Melange_edn_melange.symbol "%";
|
|
|])
|
|
~where:
|
|
(Vec.of_array
|
|
[|
|
|
where_v
|
|
(Vec.of_array
|
|
[| sym "?target"; kw "block/uuid"; sym "?target-uuid" |]);
|
|
where_v
|
|
(Vec.of_array
|
|
[|
|
|
sym "?r";
|
|
kw "logseq.property.reaction/target";
|
|
sym "?target";
|
|
|]);
|
|
where_v
|
|
(Vec.of_array
|
|
[|
|
|
sym "?r";
|
|
kw "logseq.property.reaction/emoji-id";
|
|
sym "?emoji-id";
|
|
|]);
|
|
where_l
|
|
(Vec.of_array
|
|
[|
|
|
sym "missing?";
|
|
sym "$";
|
|
sym "?r";
|
|
kw "logseq.property/created-by-ref";
|
|
|]);
|
|
|])
|
|
())
|
|
(Vec.of_array
|
|
[| Edn_util.uuid target_uuid; Edn_util.string emoji_id; empty_rules |])
|
|
|
|
let task_status_query block_uuid =
|
|
query_call
|
|
(Cli_primitive.make_datascript_query
|
|
~find:(Vec.of_array [| sym "?status-ident"; sym "." |])
|
|
~in_:
|
|
(Vec.of_array
|
|
[|
|
|
Melange_edn_melange.symbol "$";
|
|
Melange_edn_melange.symbol "?block-uuid";
|
|
|])
|
|
~where:
|
|
(Vec.of_array
|
|
[|
|
|
where_v
|
|
(Vec.of_array
|
|
[| sym "?block"; kw "block/uuid"; sym "?block-uuid" |]);
|
|
where_v
|
|
(Vec.of_array
|
|
[|
|
|
sym "?block"; kw "logseq.property/status"; sym "?status";
|
|
|]);
|
|
where_v
|
|
(Vec.of_array
|
|
[| sym "?status"; kw "db/ident"; sym "?status-ident" |]);
|
|
|])
|
|
())
|
|
(Vec.singleton (Edn_util.uuid block_uuid))
|
|
|
|
let values_of_query_result value =
|
|
match (Edn_util.as_vector value, Edn_util.as_list value) with
|
|
| Some values, _ | _, Some values -> values
|
|
| _ -> Vec.empty
|
|
|
|
let unquote_transit_value = function
|
|
| Melange_edn_melange.Any
|
|
(Melange_edn_melange.Tagged (("transit/quote" | "'"), value)) ->
|
|
value
|
|
| value -> value
|
|
|
|
let keyword_string value = value |> unquote_transit_value |> Edn_util.as_keyword
|
|
|
|
let bridge_result_value (result : bridge_result) =
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
(kw "mode", Edn_util.any result.mode);
|
|
( kw "graph",
|
|
Edn_util.string (Cli_primitive.string_of_graph result.graph) );
|
|
(kw "agent-name", Edn_util.string result.agent_name);
|
|
(kw "routed", Edn_util.vector_vec result.routed);
|
|
|])
|
|
|
|
let routed_task_value task =
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
(kw "block", task.block);
|
|
( kw "session",
|
|
match task.session with
|
|
| Some session -> Edn_util.string session
|
|
| None -> Edn_util.nil );
|
|
|])
|
|
|
|
let list_routable_tasks invoke_config repo agent_name =
|
|
let open Cli_effect in
|
|
bind
|
|
(Transport.thread_api_q invoke_config ~repo
|
|
~query:
|
|
(Edn_util.expect_vector_t "routable task query"
|
|
(routable_task_query agent_name)))
|
|
(fun result ->
|
|
let routed =
|
|
result |> values_of_query_result
|
|
|> Vec.filter (fun value ->
|
|
routable_task_decision (Entity.of_value value) ~agent_name
|
|
= Routable)
|
|
in
|
|
pure routed)
|
|
|
|
let apply_outliner_ops invoke_config repo ops =
|
|
Transport.thread_api_apply_outliner_ops invoke_config ~repo
|
|
~ops:(Edn_util.vector_t_vec ops)
|
|
~options:(Edn_util.map_t_vec Vec.empty)
|
|
|
|
let pull_registry_page invoke_config repo =
|
|
let open Cli_effect in
|
|
bind
|
|
(Transport.thread_api_q invoke_config ~repo
|
|
~query:
|
|
(Edn_util.expect_vector_t "agent registry page query"
|
|
agent_bridge_registry_page_query))
|
|
(fun pages -> pure (first_live_entity (values_of_query_result pages)))
|
|
|
|
let pull_agent_page invoke_config repo agent_name =
|
|
let open Cli_effect in
|
|
bind
|
|
(Transport.thread_api_q invoke_config ~repo
|
|
~query:
|
|
(Edn_util.expect_vector_t "registered agent query"
|
|
(registered_agent_query agent_name)))
|
|
(fun pages -> pure (first_live_entity (values_of_query_result pages)))
|
|
|
|
let create_page invoke_config repo title =
|
|
apply_outliner_ops invoke_config repo
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "create-page";
|
|
vector_vec
|
|
(Vec.of_array
|
|
[| Edn_util.string title; Edn_util.map_vec Vec.empty |]);
|
|
|]);
|
|
|])
|
|
|
|
let ensure_registry_page invoke_config repo =
|
|
let open Cli_effect in
|
|
bind (pull_registry_page invoke_config repo) (function
|
|
| Some page -> pure page
|
|
| None ->
|
|
bind (create_page invoke_config repo agent_bridge_registry_page)
|
|
(fun _ ->
|
|
bind (pull_registry_page invoke_config repo) (function
|
|
| Some page -> pure page
|
|
| None ->
|
|
error
|
|
(Failure "agent bridge registry page not found after create"))))
|
|
|
|
let register_agent_bridge invoke_config repo agent_name =
|
|
let open Cli_effect in
|
|
bind (ensure_registry_page invoke_config repo) (fun _ ->
|
|
bind (pull_agent_page invoke_config repo agent_name) (function
|
|
| Some _ -> pure ()
|
|
| None ->
|
|
bind (create_page invoke_config repo agent_name) (fun _ ->
|
|
bind (pull_agent_page invoke_config repo agent_name) (function
|
|
| Some _ -> pure ()
|
|
| None ->
|
|
error
|
|
(Failure
|
|
"agent bridge agent page not found after create")))))
|
|
|
|
let master_prompt_from_block block =
|
|
match Edn_util.get_string block "block/title" with
|
|
| Some title when title = master_prompt_wrapper_title ->
|
|
let prompts =
|
|
child_blocks block
|
|
|> Vec.filter block_has_code_tag
|
|
|> Vec.filter_map (fun child ->
|
|
Option.bind (Edn_util.get_string child "block/title") trim_non_empty)
|
|
in
|
|
if Vec.length prompts = 1 then Ok (Vec.peek_front prompts)
|
|
else if Vec.is_empty prompts then
|
|
Error
|
|
(Error.make Error.Agent_master_prompt_invalid
|
|
"agent bridge master prompt code block is missing")
|
|
else
|
|
Error
|
|
(Error.make Error.Agent_master_prompt_invalid
|
|
"agent bridge master prompt must contain one code block")
|
|
| _ ->
|
|
Error
|
|
(Error.make Error.Agent_master_prompt_invalid
|
|
"agent bridge master prompt wrapper is invalid")
|
|
|
|
let hex_digest_prefix byte_count seed =
|
|
String.sub (Sha256.hex seed) 0 (byte_count * 2)
|
|
|
|
let insert_default_master_prompt invoke_config repo agent_page_uuid =
|
|
let nonce =
|
|
Printf.sprintf "%.17g" (Time.time_to_epoch_seconds_float (Time.now ()))
|
|
in
|
|
let block_uuid =
|
|
"00000000-0000-4000-8000-"
|
|
^ hex_digest_prefix 6 (agent_page_uuid ^ ":" ^ nonce)
|
|
in
|
|
let code_uuid =
|
|
"00000000-0000-4000-8001-" ^ hex_digest_prefix 6 (block_uuid ^ ":" ^ nonce)
|
|
in
|
|
let code_block =
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
(kw "block/uuid", Edn_util.uuid code_uuid);
|
|
(kw "block/title", Edn_util.string default_master_prompt);
|
|
( kw "block/tags",
|
|
Edn_util.set_vec (Vec.of_array [| kw "logseq.class/Code-block" |])
|
|
);
|
|
(kw "logseq.property.node/display-type", kw "code");
|
|
(kw "logseq.property.code/lang", Edn_util.string "markdown");
|
|
|])
|
|
in
|
|
let wrapper_block =
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
(kw "block/uuid", Edn_util.uuid block_uuid);
|
|
(kw "block/title", Edn_util.string master_prompt_wrapper_title);
|
|
|])
|
|
in
|
|
apply_outliner_ops invoke_config repo
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "insert-blocks";
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec (Vec.of_array [| wrapper_block |]);
|
|
Edn_util.uuid agent_page_uuid;
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
(kw "outliner-op", kw "insert-blocks");
|
|
(kw "sibling?", Edn_util.bool false);
|
|
(kw "bottom?", Edn_util.bool false);
|
|
(kw "keep-uuid?", Edn_util.bool true);
|
|
|]);
|
|
|]);
|
|
|]);
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "insert-blocks";
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec (Vec.of_array [| code_block |]);
|
|
Edn_util.uuid block_uuid;
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
(kw "outliner-op", kw "insert-blocks");
|
|
(kw "sibling?", Edn_util.bool false);
|
|
(kw "bottom?", Edn_util.bool false);
|
|
(kw "keep-uuid?", Edn_util.bool true);
|
|
|]);
|
|
|]);
|
|
|]);
|
|
|])
|
|
|
|
let insert_default_master_prompt_code invoke_config repo wrapper_uuid =
|
|
let nonce =
|
|
Printf.sprintf "%.17g" (Time.time_to_epoch_seconds_float (Time.now ()))
|
|
in
|
|
let code_uuid =
|
|
"00000000-0000-4000-8001-" ^ hex_digest_prefix 6 (wrapper_uuid ^ ":" ^ nonce)
|
|
in
|
|
let code_block =
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
(kw "block/uuid", Edn_util.uuid code_uuid);
|
|
(kw "block/title", Edn_util.string default_master_prompt);
|
|
( kw "block/tags",
|
|
Edn_util.set_vec (Vec.of_array [| kw "logseq.class/Code-block" |])
|
|
);
|
|
(kw "logseq.property.node/display-type", kw "code");
|
|
(kw "logseq.property.code/lang", Edn_util.string "markdown");
|
|
|])
|
|
in
|
|
apply_outliner_ops invoke_config repo
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "insert-blocks";
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec (Vec.of_array [| code_block |]);
|
|
Edn_util.uuid wrapper_uuid;
|
|
Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
(kw "outliner-op", kw "insert-blocks");
|
|
(kw "sibling?", Edn_util.bool false);
|
|
(kw "bottom?", Edn_util.bool false);
|
|
(kw "keep-uuid?", Edn_util.bool true);
|
|
|]);
|
|
|]);
|
|
|]);
|
|
|])
|
|
|
|
let repairable_missing_master_prompt_code block =
|
|
Edn_util.get_string block "block/title" = Some master_prompt_wrapper_title
|
|
&& Option.is_some (Edn_util.get_string block "block/uuid")
|
|
&& child_blocks block |> Vec.filter block_has_code_tag |> Vec.is_empty
|
|
|
|
let ensure_agent_master_prompt invoke_config repo agent_name =
|
|
let open Cli_effect in
|
|
bind (pull_agent_page invoke_config repo agent_name) (function
|
|
| None -> error (Failure "agent bridge agent page not found")
|
|
| Some page -> (
|
|
match
|
|
( Edn_util.get_int64 page "db/id",
|
|
Edn_util.get_string page "block/uuid" )
|
|
with
|
|
| None, _ -> error (Failure "agent bridge agent page id not found")
|
|
| _, None -> error (Failure "agent bridge agent page uuid not found")
|
|
| Some page_id, Some page_uuid ->
|
|
bind
|
|
(Transport.thread_api_q invoke_config ~repo
|
|
~query:
|
|
(Edn_util.expect_vector_t "agent master prompt query"
|
|
(agent_master_prompt_blocks_query page_id)))
|
|
(fun blocks ->
|
|
match
|
|
values_of_query_result blocks
|
|
|> Vec.sort (fun a b ->
|
|
String.compare (order_key a) (order_key b))
|
|
|> first_live_entity
|
|
with
|
|
| Some block -> (
|
|
match master_prompt_from_block block with
|
|
| Ok prompt -> pure prompt
|
|
| Error err ->
|
|
if repairable_missing_master_prompt_code block then
|
|
match Edn_util.get_string block "block/uuid" with
|
|
| Some wrapper_uuid ->
|
|
bind
|
|
(insert_default_master_prompt_code invoke_config
|
|
repo wrapper_uuid) (fun _ ->
|
|
pure default_master_prompt)
|
|
| None -> error (Failure err.Error.message)
|
|
else error (Failure err.Error.message))
|
|
| None ->
|
|
bind
|
|
(insert_default_master_prompt invoke_config repo page_uuid)
|
|
(fun _ -> pure default_master_prompt))))
|
|
|
|
let ensure_prompt_templates invoke_config repo =
|
|
let open Cli_effect in
|
|
bind (ensure_registry_page invoke_config repo) (fun page ->
|
|
match
|
|
(Edn_util.get_int64 page "db/id", Edn_util.get_string page "block/uuid")
|
|
with
|
|
| None, _ -> error (Failure "agent bridge registry page id not found")
|
|
| _, None -> error (Failure "agent bridge registry page uuid not found")
|
|
| Some page_id, _ ->
|
|
bind
|
|
(Transport.thread_api_q invoke_config ~repo
|
|
~query:
|
|
(Edn_util.expect_vector_t "prompt template query"
|
|
(prompt_template_blocks_query page_id)))
|
|
(fun blocks ->
|
|
let blocks = values_of_query_result blocks in
|
|
let template_or_default kind =
|
|
match blocks_by_title blocks (prompt_template_title kind) with
|
|
| Some block -> (
|
|
match prompt_template_from_block kind block with
|
|
| Ok template -> template
|
|
| Error _ -> default_prompt_template kind)
|
|
| None -> default_prompt_template kind
|
|
in
|
|
pure
|
|
{
|
|
task = template_or_default Task;
|
|
comment = template_or_default Comment;
|
|
}))
|
|
|
|
let ensure_reaction invoke_config repo target_uuid emoji_id =
|
|
let open Cli_effect in
|
|
bind
|
|
(Transport.thread_api_q invoke_config ~repo
|
|
~query:
|
|
(Edn_util.expect_vector_t "reaction query"
|
|
(reaction_query target_uuid emoji_id)))
|
|
(fun existing ->
|
|
if not (Edn_util.is_null existing) then pure ()
|
|
else
|
|
bind
|
|
(apply_outliner_ops invoke_config repo
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "toggle-reaction";
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
Edn_util.uuid target_uuid;
|
|
Edn_util.string emoji_id;
|
|
Edn_util.nil;
|
|
|]);
|
|
|]);
|
|
|]))
|
|
(fun _ -> pure ()))
|
|
|
|
let show_task_tree config repo graph block =
|
|
let open Cli_effect in
|
|
match block_uuid block with
|
|
| None -> pure (block_title block)
|
|
| Some uuid ->
|
|
let action : Show.action =
|
|
{
|
|
repo;
|
|
graph;
|
|
target = Show.By_uuid uuid;
|
|
multi_id = false;
|
|
linked_references = false;
|
|
ref_id_footer = false;
|
|
page_hierarchy = false;
|
|
level = Some 100;
|
|
}
|
|
in
|
|
let config =
|
|
{
|
|
config with
|
|
Cli_config.output_format = Some (Output.Mode.Packed Output.Mode.Human);
|
|
}
|
|
in
|
|
bind (Show.execute action config) (fun result ->
|
|
match
|
|
Option.bind (Cli_result.data_value result) Edn_util.as_string
|
|
with
|
|
| Some text when String.trim text <> "" -> pure text
|
|
| _ -> pure (block_title block))
|
|
|
|
let show_block_tree = show_task_tree
|
|
|
|
let string_contains ~needle value =
|
|
let needle_len = String.length needle in
|
|
let value_len = String.length value in
|
|
needle_len = 0
|
|
||
|
|
let rec loop index =
|
|
index + needle_len <= value_len
|
|
&& (String.sub value index needle_len = needle || loop (index + 1))
|
|
in
|
|
loop 0
|
|
|
|
let tag_ident_matches ident tag =
|
|
ident_value tag = Some (strip_keyword_prefix ident)
|
|
|
|
let comment_tag tag = tag_ident_matches "logseq.class/Comment" tag
|
|
let comments_area_tag tag = tag_ident_matches "logseq.class/Comments" tag
|
|
|
|
let has_tag predicate block =
|
|
value_list (Edn_util.get block "block/tags") |> Vec.exists predicate
|
|
|
|
let ref_titles block =
|
|
value_list (Edn_util.get block "block/refs")
|
|
|> Vec.filter_map (fun ref ->
|
|
Option.bind (Edn_util.get_string ref "block/title") trim_non_empty)
|
|
|
|
let comment_block_matches block agent_name =
|
|
Option.is_some (block_uuid block)
|
|
&& has_tag comment_tag block
|
|
&&
|
|
let title = block_title block in
|
|
string_contains ~needle:("[[" ^ agent_name ^ "]]") title
|
|
|| Vec.mem agent_name (ref_titles block)
|
|
|
|
let comments_area_block block = has_tag comments_area_tag block
|
|
|
|
let parent_block block =
|
|
match Edn_util.get block "block/parent" with
|
|
| Some parent when Option.is_some (Edn_util.as_map parent) -> Some parent
|
|
| _ -> None
|
|
|
|
let pull_comment_block invoke_config repo block_id =
|
|
Transport.thread_api_pull invoke_config ~repo
|
|
~selector:
|
|
(Edn_util.expect_vector_t "comment block selector" comment_block_selector)
|
|
~lookup:(Edn_util.int64 block_id)
|
|
|
|
let pull_comments_area invoke_config repo comment_block =
|
|
let open Cli_effect in
|
|
match
|
|
Option.bind (parent_block comment_block) (fun parent ->
|
|
Edn_util.get_int64 parent "db/id")
|
|
with
|
|
| None -> error (Failure "comment block parent is missing")
|
|
| Some parent_id ->
|
|
Transport.thread_api_pull invoke_config ~repo
|
|
~selector:
|
|
(Edn_util.expect_vector_t "comments area selector"
|
|
comments_area_selector)
|
|
~lookup:(Edn_util.int64 parent_id)
|
|
|
|
let comments_area_target_blocks comments_area =
|
|
value_list (Edn_util.get comments_area "logseq.property.comments/blocks")
|
|
|
|
let process_comment invoke_config repo graph agent_name config master_session
|
|
comment_block =
|
|
let open Cli_effect in
|
|
let ( let* ) = bind in
|
|
let* comments_area = pull_comments_area invoke_config repo comment_block in
|
|
if not (comments_area_block comments_area) then
|
|
error (Failure "comment parent is not a comments area")
|
|
else
|
|
let target_blocks = comments_area_target_blocks comments_area in
|
|
let* target_tree_texts =
|
|
let rec loop acc remaining =
|
|
match Vec.pop_front remaining with
|
|
| None -> pure acc
|
|
| Some (block, rest) ->
|
|
let* text = show_block_tree config repo graph block in
|
|
loop (Vec.push_back acc text) rest
|
|
in
|
|
loop Vec.empty target_blocks
|
|
in
|
|
let* comments_area_tree_text =
|
|
show_block_tree config repo graph comments_area
|
|
in
|
|
let* comment_tree_text = show_block_tree config repo graph comment_block in
|
|
match
|
|
dispatch_comment_to_master config
|
|
~graph:(Cli_primitive.string_of_graph graph)
|
|
~agent_name ~master_session ~target_tree_texts ~comments_area_tree_text
|
|
~comment_tree_text comment_block
|
|
with
|
|
| Error err -> error (Failure err.Error.message)
|
|
| Ok session ->
|
|
let* () =
|
|
match block_uuid comment_block with
|
|
| None -> pure ()
|
|
| Some uuid -> ensure_reaction invoke_config repo uuid "eyes"
|
|
in
|
|
pure { block = comment_block; session = Some session }
|
|
|
|
let route_comment_candidate invoke_config repo graph agent_name config
|
|
master_session block_id =
|
|
let open Cli_effect in
|
|
let ( let* ) = bind in
|
|
let* comment_block = pull_comment_block invoke_config repo block_id in
|
|
if comment_block_matches comment_block agent_name then
|
|
let* routed =
|
|
process_comment invoke_config repo graph agent_name config master_session
|
|
comment_block
|
|
in
|
|
pure (Some routed)
|
|
else pure None
|
|
|
|
let comment_candidate_ids payload =
|
|
value_list (Edn_util.get payload "comment-route-candidate-ids")
|
|
|> Vec.filter_map Edn_util.as_int64
|
|
|
|
let route_comment_candidates invoke_config repo graph agent_name config
|
|
master_session candidate_ids =
|
|
let open Cli_effect in
|
|
let rec loop acc remaining =
|
|
match Vec.pop_front remaining with
|
|
| None -> pure acc
|
|
| Some (block_id, rest) ->
|
|
bind
|
|
(route_comment_candidate invoke_config repo graph agent_name config
|
|
master_session block_id) (function
|
|
| Some routed -> loop (Vec.push_back acc routed) rest
|
|
| None -> loop acc rest)
|
|
in
|
|
loop Vec.empty candidate_ids
|
|
|
|
let parent_block_id block =
|
|
match Edn_util.get block "block/parent" with
|
|
| Some parent -> (
|
|
match (Edn_util.as_map parent, Edn_util.as_int64 parent) with
|
|
| Some _, _ -> Edn_util.get_int64 parent "db/id"
|
|
| _, Some id -> Some id
|
|
| _ -> None)
|
|
| None -> None
|
|
|
|
let nearest_ancestor_task_session invoke_config repo block =
|
|
let open Cli_effect in
|
|
let rec loop = function
|
|
| None -> pure None
|
|
| Some parent_id ->
|
|
bind
|
|
(Transport.thread_api_pull invoke_config ~repo
|
|
~selector:
|
|
(Edn_util.expect_vector_t "task ancestor selector"
|
|
task_ancestor_session_selector)
|
|
~lookup:(Edn_util.int64 parent_id))
|
|
(fun parent ->
|
|
match
|
|
( has_task_tag parent,
|
|
Option.bind
|
|
(Edn_util.get_string parent "logseq.property.agent/session-id")
|
|
trim_non_empty,
|
|
Edn_util.get_string parent "block/uuid" )
|
|
with
|
|
| true, Some session_id, Some parent_block_uuid ->
|
|
pure (Some { parent_block_uuid; session_id })
|
|
| _ -> loop (parent_block_id parent))
|
|
in
|
|
loop (parent_block_id block)
|
|
|
|
let mark_task_started invoke_config repo block =
|
|
let open Cli_effect in
|
|
match block_uuid block with
|
|
| None -> pure ()
|
|
| Some uuid ->
|
|
bind (ensure_reaction invoke_config repo uuid "eyes") (fun () ->
|
|
bind
|
|
(Transport.thread_api_q invoke_config ~repo
|
|
~query:
|
|
(Edn_util.expect_vector_t "task status query"
|
|
(task_status_query uuid)))
|
|
(fun status ->
|
|
match keyword_string status with
|
|
| Some "logseq.property/status.todo" ->
|
|
bind
|
|
(apply_outliner_ops invoke_config repo
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
kw "batch-set-property";
|
|
vector_vec
|
|
(Vec.of_array
|
|
[|
|
|
vector_vec
|
|
(Vec.of_array
|
|
[| Edn_util.uuid uuid |]);
|
|
kw "logseq.property/status";
|
|
kw "logseq.property/status.doing";
|
|
Edn_util.map_vec Vec.empty;
|
|
|]);
|
|
|]);
|
|
|]))
|
|
(fun _ -> pure ())
|
|
| _ -> pure ()))
|
|
|
|
let process_task invoke_config repo graph agent_name config master_session block
|
|
=
|
|
let open Cli_effect in
|
|
match block_uuid block with
|
|
| Some uuid when not (claim_routing_block uuid) ->
|
|
pure { block; session = None }
|
|
| _ ->
|
|
bind (show_task_tree config repo graph block) (fun tree_text ->
|
|
bind (nearest_ancestor_task_session invoke_config repo block)
|
|
(fun inherited_session ->
|
|
match
|
|
dispatch_task_to_master config
|
|
~graph:(Cli_primitive.string_of_graph graph)
|
|
~agent_name ~master_session ?inherited_session ~tree_text
|
|
block
|
|
with
|
|
| Error err -> error (Failure err.Error.message)
|
|
| Ok session ->
|
|
bind (mark_task_started invoke_config repo block) (fun () ->
|
|
pure { block; session = Some session })))
|
|
|
|
let process_tasks invoke_config repo graph agent_name config master_session
|
|
tasks =
|
|
Cli_effect.all
|
|
(Vec.map
|
|
(process_task invoke_config repo graph agent_name config master_session)
|
|
tasks)
|
|
|
|
let bridge_log_line message = Time.rfc3339_millis (Time.now ()) ^ " " ^ message
|
|
|
|
let emit_bridge_log : type a. a Output.Mode.t -> string -> unit =
|
|
fun mode message ->
|
|
match mode with
|
|
| Output.Mode.Human -> Cli_unix.write_stdout (bridge_log_line message ^ "\n")
|
|
| Output.Mode.Json | Output.Mode.Edn -> ()
|
|
|
|
let command_preview command =
|
|
let shell_safe value =
|
|
let rec loop index =
|
|
if index >= String.length value then true
|
|
else
|
|
match value.[index] with
|
|
| 'A' .. 'Z'
|
|
| 'a' .. 'z'
|
|
| '0' .. '9'
|
|
| '.' | '_' | ':' | '/' | '=' | '-' ->
|
|
loop (index + 1)
|
|
| _ -> false
|
|
in
|
|
value <> "" && loop 0
|
|
in
|
|
let quote value =
|
|
if shell_safe value then value
|
|
else "'" ^ Vec.string_concat "'\"'\"'" (Vec.split_on_char '\'' value) ^ "'"
|
|
in
|
|
Vec.string_concat " " (Vec.map quote command)
|
|
|
|
let is_uri_component_unescaped = function
|
|
| 'A' .. 'Z'
|
|
| 'a' .. 'z'
|
|
| '0' .. '9'
|
|
| '-' | '_' | '.' | '!' | '~' | '*' | '\'' | '(' | ')' ->
|
|
true
|
|
| _ -> false
|
|
|
|
let encode_uri_component value =
|
|
let hex = "0123456789ABCDEF" in
|
|
let buffer = Buffer.create (String.length value) in
|
|
String.iter
|
|
(fun c ->
|
|
if is_uri_component_unescaped c then Buffer.add_char buffer c
|
|
else
|
|
let code = Char.code c in
|
|
Buffer.add_char buffer '%';
|
|
Buffer.add_char buffer hex.[code lsr 4];
|
|
Buffer.add_char buffer hex.[code land 0x0F])
|
|
value;
|
|
Buffer.contents buffer
|
|
|
|
let bridge_lock_name graph agent_name =
|
|
let graph = Cli_primitive.string_of_graph graph in
|
|
encode_uri_component graph ^ "--" ^ encode_uri_component agent_name ^ ".lock"
|
|
|
|
let bridge_lock_dir config graph agent_name =
|
|
Filename.concat
|
|
(Filename.concat config.Cli_config.root_dir "agent-bridge-locks")
|
|
(bridge_lock_name graph agent_name)
|
|
|
|
let bridge_lock_owner_path lock_dir = Filename.concat lock_dir "owner.edn"
|
|
|
|
let bridge_lock_owner graph agent_name =
|
|
let graph = Cli_primitive.string_of_graph graph in
|
|
Melange_edn_melange.to_edn_string
|
|
(Edn_util.map_vec
|
|
(Vec.of_array
|
|
[|
|
|
(Edn_util.keyword "pid", Edn_util.int (Cli_unix.getpid ()));
|
|
(Edn_util.keyword "graph", Edn_util.string graph);
|
|
(Edn_util.keyword "agent", Edn_util.string agent_name);
|
|
( Edn_util.keyword "started-at",
|
|
Edn_util.string
|
|
(Printf.sprintf "%.3f"
|
|
(Time.time_to_epoch_seconds_float (Time.now ()))) );
|
|
|]))
|
|
^ "\n"
|
|
|
|
let bridge_lock_error graph agent_name =
|
|
let graph = Cli_primitive.string_of_graph graph in
|
|
Error.make Error.Agent_bridge_already_running
|
|
("agent bridge is already running for graph '" ^ graph
|
|
^ "' and AgentBridge name '" ^ agent_name ^ "'")
|
|
|
|
let bridge_lock_failure message =
|
|
Error.make Error.Agent_bridge_lock_failed message
|
|
|
|
let bridge_lock_owner_pid lock_dir =
|
|
try
|
|
let owner =
|
|
Cli_unix.read_text_file (bridge_lock_owner_path lock_dir)
|
|
|> Melange_edn_melange.of_edn_string
|
|
in
|
|
Edn_util.get_int owner "pid"
|
|
with _ -> None
|
|
|
|
let stale_bridge_lock lock_dir =
|
|
match bridge_lock_owner_pid lock_dir with
|
|
| Some pid -> pid <= 0 || not (Cli_unix.process_running pid)
|
|
| None -> true
|
|
|
|
let release_bridge_lock lock_dir =
|
|
try Cli_unix.remove_tree lock_dir with _ -> ()
|
|
|
|
let acquire_bridge_lock config graph agent_name =
|
|
let lock_dir = bridge_lock_dir config graph agent_name in
|
|
let rec loop retried =
|
|
try
|
|
Cli_unix.mkdir_p (Filename.dirname lock_dir);
|
|
match Cli_unix.mkdir_exclusive lock_dir 0o755 with
|
|
| Cli_unix.Created -> (
|
|
try
|
|
Cli_unix.write_text_file
|
|
(bridge_lock_owner_path lock_dir)
|
|
(bridge_lock_owner graph agent_name);
|
|
Ok lock_dir
|
|
with exn ->
|
|
release_bridge_lock lock_dir;
|
|
Error
|
|
(bridge_lock_failure
|
|
("failed to write agent bridge lock owner: "
|
|
^ Printexc.to_string exn)))
|
|
| Cli_unix.Already_exists ->
|
|
if (not retried) && stale_bridge_lock lock_dir then (
|
|
release_bridge_lock lock_dir;
|
|
loop true)
|
|
else Error (bridge_lock_error graph agent_name)
|
|
with exn ->
|
|
Error
|
|
(bridge_lock_failure
|
|
("failed to acquire agent bridge lock: " ^ Printexc.to_string exn))
|
|
in
|
|
loop false
|
|
|
|
let with_bridge_lock config (graph : Cli_primitive.graph) agent_name mode body =
|
|
let open Cli_effect in
|
|
match acquire_bridge_lock config graph agent_name with
|
|
| Error err ->
|
|
pure (Output_mode.error ~command:Command_id.Agent_bridge mode err)
|
|
| Ok lock_dir ->
|
|
finally (body ()) (fun () ->
|
|
release_bridge_lock lock_dir;
|
|
pure ())
|
|
|
|
let route_current_tasks invoke_config repo (graph : Cli_primitive.graph)
|
|
agent_name config master_session =
|
|
let open Cli_effect in
|
|
let ( let* ) = bind in
|
|
let* tasks = list_routable_tasks invoke_config repo agent_name in
|
|
process_tasks invoke_config repo graph agent_name config master_session tasks
|
|
|
|
let execute_bridge_once repo (graph : Cli_primitive.graph) agent_name config
|
|
mode =
|
|
let open Cli_effect in
|
|
let ( let* ) = bind in
|
|
let* server =
|
|
Server_runtime.ensure_server config repo ~create_empty_db:false
|
|
in
|
|
match server with
|
|
| Error err ->
|
|
pure (Output_mode.error ~command:Command_id.Agent_bridge mode err)
|
|
| Ok invoke_config -> (
|
|
let* () = register_agent_bridge invoke_config repo agent_name in
|
|
let* master_prompt =
|
|
ensure_agent_master_prompt invoke_config repo agent_name
|
|
in
|
|
let* _prompt_templates = ensure_prompt_templates invoke_config repo in
|
|
match ensure_master_session config master_prompt with
|
|
| Error err ->
|
|
pure (Output_mode.error ~command:Command_id.Agent_bridge mode err)
|
|
| Ok master_session ->
|
|
let* routed_tasks =
|
|
route_current_tasks invoke_config repo graph agent_name config
|
|
master_session
|
|
in
|
|
let result =
|
|
{
|
|
mode = Edn_util.keyword_t "processed-once";
|
|
graph;
|
|
agent_name;
|
|
routed = Vec.map routed_task_value routed_tasks;
|
|
}
|
|
in
|
|
pure
|
|
(Cli_result.ok ~command:Command_id.Agent_bridge mode
|
|
(Raw (bridge_result_value result))))
|
|
|
|
let sync_db_changes_event_type = Edn_util.keyword_t "sync-db-changes"
|
|
|
|
let wait_forever () =
|
|
let task, _resolver = Cli_effect.wait () in
|
|
task
|
|
|
|
let execute_bridge_forever repo (graph : Cli_primitive.graph) agent_name config
|
|
mode =
|
|
let open Cli_effect in
|
|
let ( let* ) = bind in
|
|
emit_bridge_log mode "checking the environment ...";
|
|
emit_bridge_log mode ("using graph: " ^ Cli_primitive.string_of_graph graph);
|
|
emit_bridge_log mode ("using agent name: " ^ agent_name);
|
|
emit_bridge_log mode "checking codex cli ...";
|
|
let* server =
|
|
Server_runtime.ensure_server config repo ~create_empty_db:false
|
|
in
|
|
match server with
|
|
| Error err ->
|
|
pure (Output_mode.error ~command:Command_id.Agent_bridge mode err)
|
|
| Ok invoke_config -> (
|
|
emit_bridge_log mode "registering agent bridge ...";
|
|
let* () = register_agent_bridge invoke_config repo agent_name in
|
|
emit_bridge_log mode "checking master prompt ...";
|
|
let* master_prompt =
|
|
ensure_agent_master_prompt invoke_config repo agent_name
|
|
in
|
|
emit_bridge_log mode "checking prompt templates ...";
|
|
let* _prompt_templates = ensure_prompt_templates invoke_config repo in
|
|
emit_bridge_log mode
|
|
("Codex master command prepared: "
|
|
^ command_preview (build_codex_command config master_prompt));
|
|
match ensure_master_session config master_prompt with
|
|
| Error err ->
|
|
pure (Output_mode.error ~command:Command_id.Agent_bridge mode err)
|
|
| Ok master_session ->
|
|
emit_bridge_log mode
|
|
("Codex master session started: " ^ master_session);
|
|
let process_graph_changes event_type payload =
|
|
if event_type = sync_db_changes_event_type then (
|
|
emit_bridge_log mode "got graph changes: sync-db-changes";
|
|
let candidate_ids = comment_candidate_ids payload in
|
|
let* _routed_comments =
|
|
route_comment_candidates invoke_config repo graph agent_name
|
|
config master_session candidate_ids
|
|
in
|
|
let* _routed_tasks =
|
|
route_current_tasks invoke_config repo graph agent_name config
|
|
master_session
|
|
in
|
|
pure ())
|
|
else pure ()
|
|
in
|
|
let* _subscription =
|
|
Transport.connect_events invoke_config process_graph_changes
|
|
in
|
|
emit_bridge_log mode "listening graph changes ...";
|
|
let* _initial_routed_tasks =
|
|
route_current_tasks invoke_config repo graph agent_name config
|
|
master_session
|
|
in
|
|
wait_forever ())
|
|
|
|
let execute_with_mode (Agent_bridge { repo; graph }) config mode =
|
|
let open Cli_effect in
|
|
match resolve_agent_name config None with
|
|
| Error err ->
|
|
pure (Output_mode.error ~command:Command_id.Agent_bridge mode err)
|
|
| Ok agent_name ->
|
|
if not (codex_available config) then
|
|
pure
|
|
(Output_mode.error ~command:Command_id.Agent_bridge mode
|
|
(Error.make Error.Codex_not_found
|
|
"codex executable is not available"))
|
|
else
|
|
with_bridge_lock config graph agent_name mode (fun () ->
|
|
if agent_bridge_process_once config then
|
|
execute_bridge_once repo graph agent_name config mode
|
|
else execute_bridge_forever repo graph agent_name config mode)
|
|
|
|
let metadata () =
|
|
Vec.singleton
|
|
{
|
|
Command_registry.id = Command_id.Agent_bridge;
|
|
path = Command_id.to_path Command_id.Agent_bridge;
|
|
doc = "Run task agent bridge";
|
|
long_doc = None;
|
|
examples = Vec.empty;
|
|
options = Vec.empty;
|
|
category = Command_registry.Hidden;
|
|
requires_graph = Command_id.requires_graph Command_id.Agent_bridge;
|
|
requires_auth = Command_id.requires_auth Command_id.Agent_bridge;
|
|
write_command = Command_id.is_write Command_id.Agent_bridge;
|
|
human_table_headers_order = Vec.empty;
|
|
}
|
|
|
|
let execute action config =
|
|
let (Output.Mode.Packed mode) = Output_mode.for_config config in
|
|
execute_with_mode action config mode
|