type selector = | By_id of Cli_primitive.db_id | By_uuid of Cli_primitive.uuid | By_ident of Cli_primitive.keyword type opts = { id : Cli_primitive.db_id option; uuid : Cli_primitive.uuid option; ident : Cli_primitive.keyword option; } type parsed = Parsed_pull of opts type action = | Debug_pull of { repo : Cli_primitive.repo; graph : Cli_primitive.graph; lookup : selector; selector : Melange_edn_melange.any; } let parse_ident_option value = let value = String.trim value in try match Edn_util.as_keyword_t (Melange_edn_melange.of_edn_string value) with | Some keyword -> Ok keyword | None -> Error (Error.invalid_options "ident must be a strict EDN keyword (e.g. :logseq.class/Tag)") with _ -> Error (Error.invalid_options "ident must be a strict EDN keyword (e.g. :logseq.class/Tag)") let resolve_selector opts = let uuid = Option.bind opts.uuid Cli_primitive.non_empty in let selectors = Vec.empty |> (fun acc -> match opts.id with Some id -> Vec.push_back acc (By_id id) | None -> acc) |> (fun acc -> match uuid with | Some uuid -> Vec.push_back acc (By_uuid uuid) | None -> acc) |> (fun acc -> match opts.ident with | Some ident -> Vec.push_back acc (By_ident ident) | None -> acc) in match (Vec.length selectors, Vec.nth_opt selectors 0) with | 0, _ -> Error (Error.invalid_options "exactly one of --id, --uuid, or --ident is required") | 1, Some (By_uuid uuid) when not (Cli_primitive.is_uuid_string uuid) -> Error (Error.invalid_options "Option uuid must be a valid UUID string") | 1, Some selector -> Ok selector | _ -> Error (Error.invalid_options "only one of --id, --uuid, or --ident is allowed") let command_id _ = Command_id.Debug_pull let validate_parsed (Parsed_pull opts) = Error.map (fun _ -> ()) (resolve_selector opts) let selector_value = function | By_id id -> Edn_util.int64 id | By_uuid uuid -> Edn_util.vector_vec (Vec.of_array [| Edn_util.keyword "block/uuid"; Edn_util.uuid uuid |]) | By_ident ident -> Edn_util.vector_vec (Vec.of_array [| Edn_util.keyword "db/ident"; Edn_util.any ident |]) let default_selector = Edn_util.vector_vec (Vec.of_array [| Edn_util.symbol "*" |]) let build ?registry:_ config _globals (Parsed_pull opts) = Error.bind (resolve_selector opts) (fun lookup -> match config.Cli_config.repo with | Some repo -> Ok (Debug_pull { repo; graph = Cli_config.repo_to_graph repo; lookup; selector = default_selector; }) | None -> Error (Error.missing_repo "repo is required for debug pull")) let execute_with_mode (Debug_pull action) config mode = let open Cli_effect in bind (Server_runtime.ensure_server config action.repo ~create_empty_db:false) (function | Error err -> pure (Output_mode.error ~command:Command_id.Debug_pull mode err) | Ok invoke_config -> bind (Transport.thread_api_pull invoke_config ~repo:action.repo ~selector: (Edn_util.expect_vector_t "debug pull selector" action.selector) ~lookup:(selector_value action.lookup)) (fun entity -> if Edn_util.is_null entity then pure (Output_mode.error ~command:Command_id.Debug_pull mode (Error.make Error.Entity_not_found "entity not found")) else pure (Cli_result.ok ~command:Command_id.Debug_pull mode (Raw (Edn_util.map_vec (Vec.of_array [| (Edn_util.keyword "entity", entity); ( Edn_util.keyword "lookup", selector_value action.lookup ); (Edn_util.keyword "selector", action.selector); |])))))) let metadata () = Vec.of_array [| { Command_registry.id = Command_id.Debug_pull; path = Command_id.to_path Command_id.Debug_pull; doc = "Pull raw entity data for debugging"; long_doc = None; examples = Vec.empty; options = Vec.empty; category = Command_registry.Hidden; requires_graph = Command_id.requires_graph Command_id.Debug_pull; requires_auth = Command_id.requires_auth Command_id.Debug_pull; write_command = Command_id.is_write Command_id.Debug_pull; 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