type opts = { id : Cli_primitive.db_id option; uuid : Cli_primitive.uuid option; target_id : Cli_primitive.db_id option; target_uuid : Cli_primitive.uuid option; target_page : string option; pos : Block.position option; status : string option; content : string option; update_tags_edn : string option; update_properties_edn : string option; remove_tags_edn : string option; remove_properties_edn : string option; blocks_edn : string option; blocks_file : Cli_primitive.path option; } type parsed = Parsed_update_block of opts type action = { repo : Cli_primitive.repo; graph : Cli_primitive.graph; id : Cli_primitive.db_id option; uuid : Cli_primitive.uuid option; target_id : Cli_primitive.db_id option; target_uuid : Cli_primitive.uuid option; target_page : string option; pos : Block.position option; update_tags : Selector.tag Rrbvec.t; update_properties : Property.assignment Rrbvec.t; remove_tags : Selector.tag Rrbvec.t; remove_properties : Property.key Rrbvec.t; content : string option; source_label : string option; target_label : string option; } let kw value = Edn_util.keyword value let vector_vec values = Edn_util.vector_vec values let vector values = vector_vec values let trim_non_empty = function | None -> None | Some value -> let value = String.trim value in if value = "" then None else Some value let count_present values = Vec.fold_left (fun count -> function Some _ -> count + 1 | None -> count) 0 values let has_text value = Option.is_some (trim_non_empty value) let invalid_uuid_option option_name = function | Some value when not (Cli_primitive.is_uuid_string value) -> Some ("Option " ^ option_name ^ " must be a valid UUID string") | _ -> None let invalid_options (opts : opts) = let source_selectors = Vec.of_array [| Option.map Int64.to_string opts.id; trim_non_empty opts.uuid |] in let target_page = trim_non_empty opts.target_page in let target_selectors = Vec.of_array [| Option.map Int64.to_string opts.target_id; trim_non_empty opts.target_uuid; target_page; |] in let has_target = count_present target_selectors > 0 in let has_updates = has_text opts.update_tags_edn || has_text opts.update_properties_edn || has_text opts.remove_tags_edn || has_text opts.remove_properties_edn || Option.is_some opts.status || Option.is_some opts.content in match invalid_uuid_option "uuid" opts.uuid with | Some message -> Some message | None -> ( match invalid_uuid_option "target-uuid" opts.target_uuid with | Some message -> Some message | None -> if count_present source_selectors > 1 then Some "only one of --id or --uuid is allowed" else if count_present target_selectors > 1 then Some "only one of --target-id, --target-uuid, or --target-page is \ allowed" else if opts.pos = Some Block.Sibling && Option.is_some target_page then Some "--pos sibling is only valid for block targets" else if Option.is_some opts.pos && not has_target then Some "--pos is only valid when a target option is provided" else if (not has_target) && not has_updates then Some "target or update/remove options are required" else if Option.is_some opts.blocks_edn || Option.is_some opts.blocks_file then Some "--blocks and --blocks-file are only for create mode" else None) let command_id _ = Command_id.Upsert_block let validate_parsed (Parsed_update_block opts) = match invalid_options opts with | Some message -> Error (Error.invalid_options message) | None -> Ok () let parse_tags_edn _label value = match value with | None -> Ok Vec.empty | Some text when String.trim text = "" -> Ok Vec.empty | Some _ -> Add.parse_tags_vector_option value let property_key_of_value value = match ( Edn_util.as_int64 value, Edn_util.as_keyword_t value, Edn_util.as_string value ) with | Some id, _, _ -> Some (Property.Key_id id) | _, Some ident, _ -> Some (Key_ident ident) | _, _, Some name -> let name = String.trim name in if name = "" then None else Some (Key_name name) | _ -> None let edn_value_of_string ~label text = try Ok (Melange_edn_melange.of_edn_string text) with Melange_edn_melange.Parse_error _ -> Error (Error.invalid_options ("invalid " ^ label ^ " edn")) let parse_properties_edn value = match value with | None -> Ok Vec.empty | Some text when String.trim text = "" -> Ok Vec.empty | Some text -> Error.bind (edn_value_of_string ~label:"properties" text) (fun parsed -> match Edn_util.as_map parsed with | Some fields when Vec.is_empty fields -> Error (Error.invalid_options "properties must be a non-empty map") | Some fields -> let rec loop acc remaining = match Vec.pop_front remaining with | None -> Ok acc | Some ((key, value), rest) -> ( match property_key_of_value key with | Some key -> loop (Vec.push_back acc { Property.key; value }) rest | None -> Error (Error.invalid_options ("invalid property key: " ^ Melange_edn_melange.to_edn_string key))) in loop Vec.empty fields | None -> Error (Error.invalid_options "properties must be a map")) let parse_property_keys_edn value = match value with | None -> Ok Vec.empty | Some text when String.trim text = "" -> Ok Vec.empty | Some text -> Error.bind (edn_value_of_string ~label:"properties" text) (fun parsed -> match Edn_util.as_vector parsed with | Some values when Vec.is_empty values -> Error (Error.invalid_options "properties must be a non-empty vector") | Some values -> let rec loop acc remaining = match Vec.pop_front remaining with | None -> Ok acc | Some (value, rest) -> ( match property_key_of_value value with | Some key -> loop (Vec.push_back acc key) rest | None -> Error (Error.invalid_options ("invalid property key: " ^ Melange_edn_melange.to_edn_string value))) in loop Vec.empty values | None -> Error (Error.invalid_options "properties must be a vector")) let status_assignment = function | None -> Ok Vec.empty | Some status -> ( match Add.normalize_status status with | Some ident -> Ok (Vec.singleton { Property.key = Property.Key_ident (Edn_util.keyword_t "logseq.property/status"); value = Edn_util.any ident; }) | None -> Error (Error.invalid_options ("invalid status: " ^ status))) let source_label (opts : opts) = match (trim_non_empty opts.uuid, opts.id) with | Some uuid, _ -> Some uuid | None, Some id -> Some (Int64.to_string id) | None, None -> None let target_label (opts : opts) = match ( trim_non_empty opts.target_page, trim_non_empty opts.target_uuid, opts.target_id ) with | Some page, _, _ -> Some ("page:" ^ page) | None, Some uuid, _ -> Some uuid | None, None, Some id -> Some (Int64.to_string id) | None, None, None -> None let opts_has_target (opts : opts) = Option.is_some opts.target_id || Option.is_some (trim_non_empty opts.target_uuid) || Option.is_some (trim_non_empty opts.target_page) let action_has_target (action : action) = Option.is_some action.target_id || Option.is_some action.target_uuid || Option.is_some action.target_page let build_action opts repo = match invalid_options opts with | Some message -> Error (Error.invalid_options message) | None -> if Option.is_none opts.id && Option.is_none (trim_non_empty opts.uuid) then Error (Error.make Error.Missing_source "source block is required") else Error.bind (status_assignment opts.status) (fun status_properties -> Error.bind (parse_tags_edn "update-tags" opts.update_tags_edn) (fun update_tags -> Error.bind (parse_tags_edn "remove-tags" opts.remove_tags_edn) (fun remove_tags -> Error.bind (parse_properties_edn opts.update_properties_edn) (fun update_properties -> Error.bind (parse_property_keys_edn opts.remove_properties_edn) (fun remove_properties -> Ok { repo; graph = Cli_config.repo_to_graph repo; id = opts.id; uuid = trim_non_empty opts.uuid; target_id = opts.target_id; target_uuid = trim_non_empty opts.target_uuid; target_page = trim_non_empty opts.target_page; pos = (if opts_has_target opts then Some (Option.value opts.pos ~default:Block.First_child) else None); update_tags; update_properties = Vec.append status_properties update_properties; remove_tags; remove_properties; content = opts.content; source_label = source_label opts; target_label = target_label opts; }))))) let build ?registry:_ config _globals (Parsed_update_block opts) = match config.Cli_config.repo with | None -> Error (Error.missing_repo "repo is required for update") | Some repo -> build_action opts repo let block_selector = vector_vec (Vec.of_array [| kw "db/id"; kw "block/uuid"; kw "block/name"; kw "block/title" |]) let page_selector = vector_vec (Vec.of_array [| kw "db/id"; kw "block/uuid"; kw "block/name"; kw "block/title"; kw "logseq.property/deleted-at"; |]) let tag_selector = vector_vec (Vec.of_array [| kw "db/id"; kw "block/uuid"; kw "block/name"; kw "block/title" |]) let property_selector = vector_vec (Vec.of_array [| kw "db/id"; kw "db/ident"; kw "block/name"; kw "block/title"; kw "logseq.property/type"; |]) let id_of_entity value = Edn_util.get_int64 value "db/id" let uuid_of_entity value = Option.bind (Edn_util.get value "block/uuid") Edn_util.as_string_like let ident_of_entity value = Option.bind (Edn_util.get value "db/ident") Edn_util.as_keyword_t let page_entity value = Option.is_some (Edn_util.get_string value "block/name") let recycled_entity value = Option.is_some (Edn_util.get value "logseq.property/deleted-at") let page_not_found () = Error.make Error.Page_not_found "page not found" let recycled_page_error () = Error.make Error.Recycled_page "page is recycled" let pull invoke_config repo selector lookup = Transport.thread_api_pull invoke_config ~repo ~selector:(Edn_util.expect_vector_t "update pull selector" selector) ~lookup let pull_by_id invoke_config repo selector id = pull invoke_config repo selector (Edn_util.int64 id) let pull_by_uuid invoke_config repo selector uuid = pull invoke_config repo selector (vector_vec (Vec.of_array [| kw "block/uuid"; Edn_util.uuid uuid |])) let normalized_page_name value = String.lowercase_ascii (String.trim value) let variable value = Edn_util.symbol value let list_vec values = Edn_util.list_vec values let list values = list_vec values let query_value query = Edn_util.any (Cli_primitive.datascript_query_to_edn query) let class_query selector class_ident = Cli_primitive.make_datascript_query ~find: (Vec.of_array [| vector_vec (Vec.of_array [| list_vec (Vec.of_array [| variable "pull"; variable "?e"; selector |]); variable "..."; |]); |]) ~in_: (Vec.of_array [| Melange_edn_melange.symbol "$"; Melange_edn_melange.symbol "?name"; |]) ~where: (Vec.of_array [| Cli_primitive.V (Edn_util.vector_t_vec (Vec.of_array [| variable "?e"; kw "block/name"; variable "?name" |])); Cli_primitive.V (Edn_util.vector_t_vec (Vec.of_array [| variable "?e"; kw "block/tags"; variable "?t" |])); Cli_primitive.V (Edn_util.vector_t_vec (Vec.of_array [| variable "?t"; kw "db/ident"; kw class_ident |])); |]) () let tag_query selector = query_value (class_query selector "logseq.class/Tag") let property_query selector = class_query selector "logseq.class/Property" let first_entity value = match (Edn_util.as_vector value, Edn_util.as_list value, Edn_util.as_map value) with | Some values, _, _ when not (Vec.is_empty values) -> Some (Vec.peek_front values) | _, Some values, _ when not (Vec.is_empty values) -> Some (Vec.peek_front values) | _, _, Some _ -> Some value | _ -> None let pull_tag_by_name invoke_config repo name = Transport.thread_api_q invoke_config ~repo ~query: (Edn_util.vector_t_vec (Vec.of_array [| tag_query tag_selector; Edn_util.string (normalized_page_name name); |])) let list_tags invoke_config repo = Transport.thread_api_cli_list_tags invoke_config ~repo ~options:(Edn_util.map_t_vec Vec.empty) let tag_name_matches name entity = let expected = normalized_page_name name in let matches value = String.equal (normalized_page_name value) expected in match ( Edn_util.get_string entity "block/title", Edn_util.get_string entity "block/name" ) with | Some title, _ when matches title -> true | _, Some name when matches name -> true | _ -> false let find_tag_by_name invoke_config repo name = let open Cli_effect in bind (list_tags invoke_config repo) (fun value -> match Edn_util.as_seq value with | Some tags -> pure (Vec.find_opt (tag_name_matches name) tags) | None -> pure None) let pull_property_by_name invoke_config repo name = Transport.thread_api_q invoke_config ~repo ~query: (Edn_util.vector_t_vec (Vec.of_array [| query_value (property_query property_selector); Edn_util.string (normalized_page_name name); |])) let source_not_found () = Error.make Error.Source_not_found "source block not found" let target_not_found () = Error.make Error.Target_not_found "target block not found" let ensure_non_page entity message code = if page_entity entity then Error (Error.make code message) else Ok entity let resolve_source invoke_config repo action = let open Cli_effect in match (action.id, action.uuid) with | Some id, _ -> bind (pull_by_id invoke_config repo block_selector id) (fun entity -> match id_of_entity entity with | None -> pure (Error (source_not_found ())) | Some _ -> pure (ensure_non_page entity "source must be a non-page block" Error.Invalid_source)) | None, Some uuid -> bind (pull_by_uuid invoke_config repo block_selector uuid) (fun entity -> match id_of_entity entity with | None -> pure (Error (source_not_found ())) | Some _ -> pure (ensure_non_page entity "source must be a non-page block" Error.Invalid_source)) | None, None -> pure (Error (Error.make Error.Missing_source "source is required")) let resolve_target invoke_config repo action = let open Cli_effect in match (action.target_id, action.target_uuid, action.target_page) with | Some id, _, _ -> bind (pull_by_id invoke_config repo block_selector id) (fun entity -> match id_of_entity entity with | None -> pure (Error (target_not_found ())) | Some _ -> pure (ensure_non_page entity "target must be a block" Error.Invalid_target)) | None, Some uuid, _ -> bind (pull_by_uuid invoke_config repo block_selector uuid) (fun entity -> match id_of_entity entity with | None -> pure (Error (target_not_found ())) | Some _ -> pure (ensure_non_page entity "target must be a block" Error.Invalid_target)) | None, None, Some page -> bind (pull invoke_config repo page_selector (vector_vec (Vec.of_array [| kw "block/name"; Edn_util.string (normalized_page_name page); |]))) (fun entity -> match id_of_entity entity with | None -> pure (Error (page_not_found ())) | Some _ when recycled_entity entity -> pure (Error (recycled_page_error ())) | Some _ -> pure (Ok entity)) | None, None, None -> pure (Error (Error.make Error.Missing_target "target is required")) let pos_opts = function | Some Block.Last_child -> Edn_util.map_vec (Vec.of_array [| (kw "sibling?", Edn_util.bool false); (kw "bottom?", Edn_util.bool true); |]) | Some Sibling -> Edn_util.map_vec (Vec.of_array [| (kw "sibling?", Edn_util.bool true) |]) | Some First_child | None -> Edn_util.map_vec (Vec.of_array [| (kw "sibling?", Edn_util.bool false) |]) let lookup_of_tag = function | Selector.Tag_id id -> Edn_util.int64 id | Tag_name name -> Edn_util.string (normalized_page_name name) | Tag_ident ident -> Edn_util.any ident | Tag_uuid uuid -> Edn_util.uuid uuid let resolve_tag_id invoke_config repo = function | Selector.Tag_id id -> Cli_effect.pure (Ok id) | Tag_name name -> let open Cli_effect in bind (find_tag_by_name invoke_config repo name) (fun result -> match Option.bind result id_of_entity with | Some id -> pure (Ok id) | None -> pure (Error (Error.make Error.Tag_not_found "tag not found"))) | (Tag_ident _ | Tag_uuid _) as tag -> let open Cli_effect in bind (pull invoke_config repo tag_selector (lookup_of_tag tag)) (fun result -> match id_of_entity result with | Some id -> pure (Ok id) | None -> pure (Error (Error.make Error.Tag_not_found "tag not found"))) let resolve_property_ident invoke_config repo = function | Property.Key_ident ident -> Cli_effect.pure (Ok ident) | Key_id id -> let open Cli_effect in bind (pull invoke_config repo (vector_vec (Vec.of_array [| kw "db/ident" |])) (Edn_util.int64 id)) (fun result -> match ident_of_entity result with | Some ident -> pure (Ok ident) | None -> pure (Error (Error.make Error.Property_not_found "property not found"))) | Key_name name -> let open Cli_effect in bind (pull_property_by_name invoke_config repo name) (fun result -> match Option.bind (first_entity result) ident_of_entity with | Some ident -> pure (Ok ident) | None -> let ident = Edn_util.keyword_t name in bind (pull invoke_config repo (vector_vec (Vec.of_array [| kw "db/id" |])) (vector_vec (Vec.of_array [| kw "db/ident"; Edn_util.any ident |]))) (fun result -> if Option.is_some (id_of_entity result) then pure (Ok ident) else pure (Error (Error.make Error.Property_not_found "property not found")))) let resolve_tag_ids invoke_config repo tags = let open Cli_effect in let rec loop acc remaining = match Vec.pop_front remaining with | None -> pure (Ok acc) | Some (tag, rest) -> bind (resolve_tag_id invoke_config repo tag) (function | Error err -> pure (Error err) | Ok id -> loop (Vec.push_back acc id) rest) in loop Vec.empty tags let resolve_property_keys invoke_config repo keys = let open Cli_effect in let rec loop acc remaining = match Vec.pop_front remaining with | None -> pure (Ok acc) | Some (key, rest) -> bind (resolve_property_ident invoke_config repo key) (function | Error err -> pure (Error err) | Ok ident -> loop (Vec.push_back acc ident) rest) in loop Vec.empty keys let resolve_property_assignments invoke_config repo assignments = let open Cli_effect in let rec loop acc remaining = match Vec.pop_front remaining with | None -> pure (Ok acc) | Some (assignment, rest) -> bind (resolve_property_ident invoke_config repo assignment.Property.key) (function | Error err -> pure (Error err) | Ok ident -> loop (Vec.push_back acc (ident, assignment.value)) rest) in loop Vec.empty assignments let property_ops block_uuids ~update_tag_ids ~remove_tag_ids ~update_properties ~remove_properties = let uuid_values = Edn_util.vector_vec (block_uuids |> Vec.map (fun uuid -> Edn_util.uuid uuid)) in let remove_tag_ops = Vec.map (fun tag_id -> Edn_util.vector_vec (Vec.of_array [| kw "batch-delete-property-value"; Edn_util.vector_vec (Vec.of_array [| uuid_values; kw "block/tags"; Edn_util.int64 tag_id |]); |])) remove_tag_ids in let remove_property_ops = Vec.map (fun ident -> Edn_util.vector_vec (Vec.of_array [| kw "batch-remove-property"; Edn_util.vector_vec (Vec.of_array [| uuid_values; Edn_util.any ident |]); |])) remove_properties in let update_tag_ops = Vec.map (fun tag_id -> Edn_util.vector_vec (Vec.of_array [| kw "batch-set-property"; Edn_util.vector_vec (Vec.of_array [| uuid_values; kw "block/tags"; Edn_util.int64 tag_id; Edn_util.map_vec Vec.empty; |]); |])) update_tag_ids in let update_property_ops = Vec.map (fun (ident, value) -> Edn_util.vector_vec (Vec.of_array [| kw "batch-set-property"; Edn_util.vector_vec (Vec.of_array [| uuid_values; Edn_util.any ident; value; Edn_util.map_vec Vec.empty; |]); |])) update_properties in Vec.append remove_tag_ops (Vec.append remove_property_ops (Vec.append update_tag_ops update_property_ops)) let resolve_update_ops invoke_config repo action block_uuids = let open Cli_effect in bind (resolve_tag_ids invoke_config repo action.update_tags) (function | Error err -> pure (Error err) | Ok update_tag_ids -> bind (resolve_tag_ids invoke_config repo action.remove_tags) (function | Error err -> pure (Error err) | Ok remove_tag_ids -> bind (resolve_property_assignments invoke_config repo action.update_properties) (function | Error err -> pure (Error err) | Ok update_properties -> bind (resolve_property_keys invoke_config repo action.remove_properties) (function | Error err -> pure (Error err) | Ok remove_properties -> pure (Ok (property_ops block_uuids ~update_tag_ids ~remove_tag_ids ~update_properties ~remove_properties)))))) 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 save_ops source_uuid = function | Some content -> Vec.singleton (Edn_util.vector_vec (Vec.of_array [| kw "save-block"; Edn_util.vector_vec (Vec.of_array [| Edn_util.map_vec (Vec.of_array [| (kw "block/uuid", Edn_util.uuid source_uuid); (kw "block/title", Edn_util.string content); |]); Edn_util.map_vec Vec.empty; |]); |])) | None -> Vec.empty let move_ops source_uuid pos = function | Some target_uuid -> Vec.singleton (Edn_util.vector_vec (Vec.of_array [| kw "move-blocks"; Edn_util.vector_vec (Vec.of_array [| Edn_util.vector_vec (Vec.of_array [| Edn_util.uuid source_uuid |]); Edn_util.uuid target_uuid; pos_opts pos; |]); |])) | None -> Vec.empty let execute_ops mode invoke_config action source_uuid target_uuid = let open Cli_effect in bind (resolve_update_ops invoke_config action.repo action (Vec.singleton source_uuid)) (function | Error err -> pure (Cli_result.error ~command:Command_id.Upsert_block mode err) | Ok property_ops -> let ops = Vec.append (save_ops source_uuid action.content) (Vec.append (move_ops source_uuid action.pos target_uuid) property_ops) in if Vec.is_empty ops then pure (Cli_result.ok ~command:Command_id.Upsert_block mode (Raw (Edn_util.map_vec (Vec.of_array [| (kw "result", Edn_util.nil) |])))) else bind (apply_outliner_ops invoke_config action.repo ops) (fun result -> pure (Cli_result.ok ~command:Command_id.Upsert_block mode (Raw (Edn_util.map_vec (Vec.of_array [| (kw "result", result) |])))))) let resolve_optional_target_uuid invoke_config action = let open Cli_effect in if action_has_target action then bind (resolve_target invoke_config action.repo action) (function | Error err -> pure (Error err) | Ok target -> ( match uuid_of_entity target with | Some target_uuid -> pure (Ok (Some target_uuid)) | None -> pure (Error (Error.make Error.Target_not_found "target block uuid not found")))) else pure (Ok None) let execute action config mode = let open Cli_effect in bind (Server_runtime.ensure_server config action.repo ~create_empty_db:false) (function | Error err -> pure (Cli_result.error ~command:Command_id.Upsert_block mode err) | Ok invoke_config -> bind (resolve_source invoke_config action.repo action) (function | Error err -> pure (Cli_result.error ~command:Command_id.Upsert_block mode err) | Ok source -> ( match uuid_of_entity source with | None -> pure (Cli_result.error ~command:Command_id.Upsert_block mode (Error.make Error.Source_not_found "source block uuid not found")) | Some source_uuid -> bind (resolve_optional_target_uuid invoke_config action) (function | Error err -> pure (Cli_result.error ~command:Command_id.Upsert_block mode err) | Ok target_uuid -> execute_ops mode invoke_config action source_uuid target_uuid)))) let metadata () = Vec.singleton { Command_registry.id = Command_id.Upsert_block; path = Command_id.to_path Command_id.Upsert_block; doc = "Upsert block"; long_doc = None; examples = Vec.of_array [| "logseq upsert block --graph my-graph --id 123 --content \"Updated \ content\""; "logseq upsert block --graph my-graph --id 123 --target-page Home \ --pos last-child"; "logseq upsert block --graph my-graph --uuid \ 11111111-1111-1111-1111-111111111111 --status done"; |]; options = Vec.empty; category = Command_registry.Graph_inspect_and_edit; requires_graph = Command_id.requires_graph Command_id.Upsert_block; requires_auth = Command_id.requires_auth Command_id.Upsert_block; write_command = Command_id.is_write Command_id.Upsert_block; human_table_headers_order = Vec.empty; }