Initial import of LogDarioSeq baseline
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>
This commit is contained in:
851
cli/lib/update.ml
Normal file
851
cli/lib/update.ml
Normal file
@@ -0,0 +1,851 @@
|
||||
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;
|
||||
}
|
||||
Reference in New Issue
Block a user