type opts = {
  target_id : Cli_primitive.db_id option;
  target_uuid : Cli_primitive.uuid option;
  target_page_name : string option;
  pos : Block.position option;
  status : string option;
  tags_edn : string option;
  properties_edn : string option;
  content : string option;
  blocks_edn : string option;
  blocks_file : Cli_primitive.path option;
}

type action = {
  repo : Cli_primitive.repo;
  graph : Cli_primitive.graph;
  target_id : Cli_primitive.db_id option;
  target_uuid : Cli_primitive.uuid option;
  target_page_name : string option;
  pos : Block.position;
  status : Cli_primitive.keyword option;
  tags : Selector.tag Rrbvec.t;
  properties : Property.assignment Rrbvec.t;
  blocks : Block.t Rrbvec.t;
}

let kw value = Edn_util.keyword value
let vector_vec values = Edn_util.vector_vec values
let vector values = vector_vec values
let list_vec values = Edn_util.list_vec values
let list values = list_vec values
let sym value = Edn_util.symbol value
let normalized_lookup_name value = String.lowercase_ascii (String.trim value)

let query_value query =
  Edn_util.any (Cli_primitive.datascript_query_to_edn query)

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 strip_tag_prefix value =
  let value = String.trim value in
  let rec loop index =
    if index < String.length value && value.[index] = '#' then loop (index + 1)
    else index
  in
  let start = loop 0 in
  String.sub value start (String.length value - start) |> String.trim

let tag_of_value value =
  match
    ( Edn_util.as_int64 value,
      Edn_util.as_uuid value,
      Edn_util.as_keyword_t value,
      Edn_util.as_string value )
  with
  | Some id, _, _, _ -> Some (Selector.Tag_id id)
  | _, Some uuid, _, _ -> Some (Tag_uuid uuid)
  | _, _, Some ident, _ -> Some (Tag_ident ident)
  | _, _, _, Some value ->
      let value = strip_tag_prefix value in
      if value = "" then None
      else if Cli_primitive.is_uuid_string value then Some (Tag_uuid value)
      else if value.[0] = ':' then Some (Tag_ident (Edn_util.keyword_t value))
      else Some (Tag_name value)
  | _ -> None

let parse_tags_option = function
  | None -> Ok Vec.empty
  | Some text ->
      Error.bind (edn_value_of_string ~label:"tags" text) (fun value ->
          match Edn_util.as_vector value with
          | Some values when Vec.is_empty values ->
              Error (Error.invalid_options "tags must be a non-empty vector")
          | Some values ->
              let rec loop acc values =
                match Vec.pop_front values with
                | None -> Ok acc
                | Some (value, rest) -> (
                    match tag_of_value value with
                    | Some tag -> loop (Vec.push_back acc tag) rest
                    | None ->
                        Error
                          (Error.invalid_options
                             "tags must be strings, keywords, uuids, or ids"))
              in
              loop Vec.empty values
          | None -> Error (Error.invalid_options "tags must be a vector"))

let parse_tags_vector_option = parse_tags_option

let normalize_property_name value =
  let value = String.trim value in
  if value = "" then None else Some (Edn_util.keyword_t 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 value ->
      Option.map
        (fun ident -> Property.Key_ident ident)
        (normalize_property_name value)
  | _ -> None

let parse_properties_option ?(allow_non_built_in = false) = function
  | None -> Ok Vec.empty
  | Some text ->
      let _ = allow_non_built_in in
      Error.bind (edn_value_of_string ~label:"properties" text) (fun value ->
          match Edn_util.as_map value 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 fields =
                match Vec.pop_front fields 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_properties_vector_option ?(allow_non_built_in = false) = function
  | None -> Ok Vec.empty
  | Some text ->
      let _ = allow_non_built_in in
      Error.bind (edn_value_of_string ~label:"properties" text) (fun value ->
          match Edn_util.as_vector value 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 values =
                match Vec.pop_front values 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 normalize_status value =
  match String.lowercase_ascii (String.trim value) with
  | "" -> None
  | "todo" | "later" -> Some (Edn_util.keyword_t "logseq.property/status.todo")
  | "doing" | "now" | "in-progress" | "in progress" | "inprogress" ->
      Some (Edn_util.keyword_t "logseq.property/status.doing")
  | "done" -> Some (Edn_util.keyword_t "logseq.property/status.done")
  | "wait" | "waiting" | "backlog" ->
      Some (Edn_util.keyword_t "logseq.property/status.backlog")
  | "canceled" | "cancelled" ->
      Some (Edn_util.keyword_t "logseq.property/status.canceled")
  | "in-review" | "in_review" | "inreview" ->
      Some (Edn_util.keyword_t "logseq.property/status.in-review")
  | value when String.length value > 0 && value.[0] = ':' ->
      Some (Edn_util.keyword_t value)
  | _ -> None

let invalid_options (opts : opts) =
  let target_selectors =
    Vec.filter Option.is_some
      (Vec.of_array
         [|
           Option.map Int64.to_string opts.target_id;
           opts.target_uuid;
           Option.map String.trim opts.target_page_name;
         |])
  in
  let nonempty = function
    | Some value -> String.trim value <> ""
    | None -> false
  in
  let has_blocks =
    nonempty opts.blocks_edn || Option.is_some opts.blocks_file
  in
  let has_metadata = nonempty opts.tags_edn || nonempty opts.properties_edn in
  let invalid_target_uuid =
    match opts.target_uuid with
    | Some uuid -> not (Cli_primitive.is_uuid_string uuid)
    | None -> false
  in
  match (opts.pos, opts.target_page_name, target_selectors) with
  | _, _, _ when invalid_target_uuid ->
      Some "Option target-uuid must be a valid UUID string"
  | Some Block.Sibling, Some page, _ when String.trim page <> "" ->
      Some "--pos sibling is only valid for block targets"
  | Some Block.Sibling, _, selectors when Vec.is_empty selectors ->
      Some "--pos sibling is only valid for block targets"
  | _, _, _ when Vec.length target_selectors > 1 ->
      Some
        "only one of --target-id, --target-uuid, or --target-page-name is \
         allowed"
  | _, _, _ when has_blocks && has_metadata ->
      Some
        "tags and properties cannot be combined with --blocks or --blocks-file"
  | _ -> None

module Node_crypto = struct
  external random_uuid : unit -> string = "randomUUID" [@@mel.module "crypto"]
end

let generate_uuid = Node_crypto.random_uuid
let unique = Uuid_refs_types.unique_preserve_order

let extract_page_refs title =
  title |> Uuid_refs_types.extract_wiki_refs
  |> Vec.filter_map (fun ref_title ->
      let ref_title = String.trim ref_title in
      if ref_title = "" || Cli_primitive.is_uuid_string ref_title then None
      else Some ref_title)
  |> unique

let rec block_of_value raw =
  match Edn_util.as_map raw with
  | Some fields ->
      let find key =
        Vec.find_map
          (fun (k, v) ->
            match Edn_util.as_string_like k with
            | Some k when k = key -> Some v
            | _ -> None)
          fields
      in
      let title =
        match
          ( Option.bind (find "block/title") Edn_util.as_string,
            Option.bind (find "block/content") Edn_util.as_string )
        with
        | Some value, _ | _, Some value -> Some value
        | _ -> None
      in
      let uuid = Option.bind (find "block/uuid") Edn_util.as_string_like in
      let tags =
        Option.value
          (Option.map
             (Vec.filter_map tag_of_value)
             (Option.bind (find "block/tags") Edn_util.as_seq))
          ~default:Vec.empty
      in
      let children =
        Option.value
          (Option.map (Vec.map block_of_value)
             (Option.bind (find "block/children") Edn_util.as_seq))
          ~default:Vec.empty
      in
      { (Block.make ?uuid ?title ~children ()) with tags; raw }
  | None -> (
      match Edn_util.as_string raw with
      | Some title -> Block.make ~title ()
      | None -> { (Block.make ()) with raw })

let ensure_block_uuid block =
  match block.Block.uuid with
  | Some _ -> block
  | None -> { block with uuid = Some (generate_uuid ()) }

let rec ensure_block_uuids block =
  let children = Vec.map ensure_block_uuids block.Block.children in
  ensure_block_uuid { block with children }

let parse_blocks_edn ~label text =
  Error.bind (edn_value_of_string ~label text) (function value ->
      (match Edn_util.as_vector value with
      | Some values -> Ok (Vec.map block_of_value values)
      | None ->
          Error (Error.make Error.Invalid_blocks "blocks must be a vector")))

let read_file path = Cli_unix.read_text_file path

let read_blocks (opts : opts) args =
  match
    (opts.blocks_edn, opts.blocks_file, Option.map String.trim opts.content)
  with
  | Some text, _, _ -> parse_blocks_edn ~label:"blocks" text
  | None, Some path, _ -> parse_blocks_edn ~label:"blocks" (read_file path)
  | None, None, Some content when content <> "" ->
      Ok (Vec.singleton (Block.make ~title:content ()))
  | None, None, _ when not (Vec.is_empty args) ->
      Ok (Vec.singleton (Block.make ~title:(Vec.string_concat " " args) ()))
  | _ -> Error (Error.make Error.Missing_content "content is required")

let build_add_block_action (opts : opts) args repo =
  match invalid_options opts with
  | Some message -> Error (Error.invalid_options message)
  | None ->
      Error.bind (read_blocks opts args) (fun blocks ->
          Error.bind (parse_tags_option opts.tags_edn) (fun tags ->
              Error.bind (parse_properties_option opts.properties_edn)
                (fun properties ->
                  let pos = Option.value opts.pos ~default:Block.Last_child in
                  let status = Option.bind opts.status normalize_status in
                  match (Option.map String.trim opts.status, status) with
                  | Some status_text, None when status_text <> "" ->
                      Error
                        (Error.invalid_options
                           ("invalid status: " ^ status_text))
                  | _ ->
                      let blocks = Vec.map ensure_block_uuids blocks in
                      Ok
                        {
                          repo;
                          graph = Cli_config.repo_to_graph repo;
                          target_id = opts.target_id;
                          target_uuid = opts.target_uuid;
                          target_page_name = opts.target_page_name;
                          pos;
                          status;
                          tags;
                          properties;
                          blocks;
                        })))

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";
         Edn_util.map_vec
           (Vec.of_array
              [|
                (kw "block/tags", vector_vec (Vec.of_array [| kw "db/ident" |]));
              |]);
         kw "logseq.property/public?";
         kw "logseq.property/built-in?";
       |])

let property_entity_selector =
  vector_vec
    (Vec.of_array
       [|
         kw "db/id";
         kw "db/ident";
         kw "block/name";
         kw "block/title";
         kw "logseq.property/type";
         kw "db/cardinality";
         kw "logseq.property/public?";
       |])

let page_query selector =
  Cli_primitive.make_datascript_query
    ~find:
      (Vec.singleton
         (vector_vec
            (Vec.of_array
               [|
                 list_vec (Vec.of_array [| sym "pull"; sym "?e"; selector |]);
                 sym "...";
               |])))
    ~in_:
      (Vec.of_array
         [|
           Melange_edn_melange.symbol "$"; Melange_edn_melange.symbol "?name";
         |])
    ~where:
      (Vec.singleton
         (Cli_primitive.V
            (Edn_util.vector_t_vec
               (Vec.of_array [| sym "?e"; kw "block/name"; sym "?name" |]))))
    ()

let tag_query selector =
  Cli_primitive.make_datascript_query
    ~find:
      (Vec.singleton
         (vector_vec
            (Vec.of_array
               [|
                 list_vec (Vec.of_array [| sym "pull"; sym "?e"; selector |]);
                 sym "...";
               |])))
    ~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 [| sym "?e"; kw "block/name"; sym "?name" |]));
           Cli_primitive.V
             (Edn_util.vector_t_vec
                (Vec.of_array [| sym "?e"; kw "block/tags"; sym "?t" |]));
           Cli_primitive.V
             (Edn_util.vector_t_vec
                (Vec.of_array
                   [| sym "?t"; kw "db/ident"; kw "logseq.class/Tag" |]));
         |])
    ()

let property_query selector =
  Cli_primitive.make_datascript_query
    ~find:
      (Vec.singleton
         (vector_vec
            (Vec.of_array
               [|
                 list_vec (Vec.of_array [| sym "pull"; sym "?e"; selector |]);
                 sym "...";
               |])))
    ~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 [| sym "?e"; kw "block/name"; sym "?name" |]));
           Cli_primitive.V
             (Edn_util.vector_t_vec
                (Vec.of_array [| sym "?e"; kw "block/tags"; sym "?t" |]));
           Cli_primitive.V
             (Edn_util.vector_t_vec
                (Vec.of_array
                   [| sym "?t"; kw "db/ident"; kw "logseq.class/Property" |]));
         |])
    ()

let first_entity = function
  | 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 uuid_of_entity value =
  Option.bind (Edn_util.get value "block/uuid") Edn_util.as_string_like

let id_of_entity value = Edn_util.get_int64 value "db/id"

let ident_of_entity value =
  Option.bind (Edn_util.get value "db/ident") Edn_util.as_keyword_t

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_entity config repo selector lookup =
  Transport.thread_api_pull config ~repo
    ~selector:(Edn_util.expect_vector_t "add pull selector" selector)
    ~lookup

let apply_outliner_ops config repo ops =
  Transport.thread_api_apply_outliner_ops config ~repo
    ~ops:(Edn_util.vector_t_vec ops)
    ~options:(Edn_util.map_t_vec Vec.empty)

let create_page config repo name =
  let op =
    Edn_util.vector_vec
      (Vec.of_array
         [|
           kw "create-page";
           Edn_util.vector_vec
             (Vec.of_array
                [| Edn_util.string name; Edn_util.map_vec Vec.empty |]);
         |])
  in
  apply_outliner_ops config repo (Vec.singleton op)

let pull_pages_by_name config repo name selector =
  Transport.thread_api_q config ~repo
    ~query:
      (Edn_util.vector_t_vec
         (Vec.of_array
            [|
              query_value (page_query selector);
              Edn_util.string (normalized_lookup_name name);
            |]))

let pull_tag_by_name config repo name selector =
  Transport.thread_api_q config ~repo
    ~query:
      (Edn_util.vector_t_vec
         (Vec.of_array
            [|
              query_value (tag_query selector);
              Edn_util.string (normalized_lookup_name name);
            |]))

let list_tags config repo =
  Transport.thread_api_cli_list_tags config ~repo
    ~options:(Edn_util.map_t_vec Vec.empty)

let tag_name_matches name entity =
  let expected = normalized_lookup_name name in
  let matches value = String.equal (normalized_lookup_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 config repo name =
  let open Cli_effect in
  bind (list_tags 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 config repo name selector =
  Transport.thread_api_q config ~repo
    ~query:
      (Edn_util.vector_t_vec
         (Vec.of_array
            [|
              query_value (property_query selector);
              Edn_util.string (normalized_lookup_name name);
            |]))

let pull_created_page config repo name create_result =
  let uuid_value =
    match
      (Edn_util.as_vector create_result, Edn_util.as_list create_result)
    with
    | Some values, _ -> Vec.nth_opt values 1
    | _, Some values -> Vec.nth_opt values 1
    | _ -> None
  in
  match uuid_value with
  | Some uuid_value -> (
      match Edn_util.as_string_like uuid_value with
      | Some uuid ->
          pull_entity config repo page_selector
            (vector_vec
               (Vec.of_array [| kw "block/uuid"; Edn_util.uuid uuid |]))
      | _ ->
          pull_entity config repo page_selector
            (vector_vec
               (Vec.of_array
                  [|
                    kw "block/name";
                    Edn_util.string (normalized_lookup_name name);
                  |])))
  | _ ->
      pull_entity config repo page_selector
        (vector_vec
           (Vec.of_array
              [|
                kw "block/name"; Edn_util.string (normalized_lookup_name name);
              |]))

let ensure_page_entity config repo page_name =
  let open Cli_effect in
  bind (pull_pages_by_name config repo page_name page_selector) (fun result ->
      match first_entity result with
      | Some entity when recycled_entity entity ->
          pure (Error (recycled_page_error ()))
      | Some entity -> pure (Ok entity)
      | None ->
          bind (create_page config repo page_name) (fun create_result ->
              bind (pull_created_page config repo page_name create_result)
                (fun page ->
                  match uuid_of_entity page with
                  | Some _ -> pure (Ok page)
                  | None -> pure (Error (page_not_found ())))))

let ensure_page config repo page_name =
  let open Cli_effect in
  bind (ensure_page_entity config repo page_name) (function
    | Ok entity -> (
        match uuid_of_entity entity with
        | Some uuid -> pure (Ok uuid)
        | None -> pure (Error (page_not_found ())))
    | Error err -> pure (Error err))

let resolve_add_target config (action : action) =
  let open Cli_effect in
  match (action.target_id, action.target_uuid, action.target_page_name) with
  | Some id, _, _ ->
      bind
        (pull_entity config action.repo
           (vector_vec
              (Vec.of_array [| kw "db/id"; kw "block/uuid"; kw "block/title" |]))
           (Edn_util.int64 id))
        (fun block ->
          match uuid_of_entity block with
          | Some uuid -> pure (Ok uuid)
          | None ->
              pure
                (Error
                   (Error.make Error.Target_not_found "target block not found")))
  | None, Some uuid, _ ->
      bind
        (pull_entity config action.repo
           (vector_vec
              (Vec.of_array [| kw "db/id"; kw "block/uuid"; kw "block/title" |]))
           (vector_vec (Vec.of_array [| kw "block/uuid"; Edn_util.uuid uuid |])))
        (fun block ->
          match uuid_of_entity block with
          | Some uuid -> pure (Ok uuid)
          | None ->
              pure
                (Error
                   (Error.make Error.Target_not_found "target block not found")))
  | None, None, Some page_name -> ensure_page config action.repo page_name
  | None, None, None ->
      pure
        (Error
           (Error.make Error.Missing_target "target page or block is required"))

let flatten_blocks blocks =
  let rec flatten_one parent_uuid block =
    let parent =
      match parent_uuid with
      | Some uuid -> Some (Selector.Block_uuid uuid)
      | None -> block.Block.parent
    in
    let children = block.children in
    let block = { block with parent; children = Vec.empty } in
    let child_parent_uuid = block.Block.uuid in
    Vec.push_front
      (Vec.concat_map (flatten_one child_parent_uuid) children)
      block
  in
  Vec.concat_map (flatten_one None) blocks

let insert_opts = function
  | Block.Last_child ->
      Edn_util.map_vec
        (Vec.of_array
           [|
             (kw "sibling?", Edn_util.bool false);
             (kw "bottom?", Edn_util.bool true);
             (kw "keep-uuid?", Edn_util.bool true);
             (kw "outliner-op", kw "insert-blocks");
           |])
  | First_child ->
      Edn_util.map_vec
        (Vec.of_array
           [|
             (kw "sibling?", Edn_util.bool false);
             (kw "keep-uuid?", Edn_util.bool true);
             (kw "outliner-op", kw "insert-blocks");
           |])
  | Sibling ->
      Edn_util.map_vec
        (Vec.of_array
           [|
             (kw "sibling?", Edn_util.bool true);
             (kw "keep-uuid?", Edn_util.bool true);
             (kw "outliner-op", kw "insert-blocks");
           |])

let collect_uuids_from_value value =
  let rec loop acc value =
    match Edn_util.as_map value with
    | Some fields ->
        let acc =
          match
            Option.bind
              (Edn_util.get value "block/uuid")
              Edn_util.as_string_like
          with
          | Some uuid -> Vec.push_back acc uuid
          | _ -> acc
        in
        Vec.fold_left (fun acc (k, v) -> loop (loop acc k) v) acc fields
    | None -> (
        match Edn_util.as_seq value with
        | Some values -> Vec.fold_left loop acc values
        | None -> acc)
  in
  loop Vec.empty value

let collect_action_block_uuids blocks =
  blocks |> flatten_blocks
  |> Vec.filter_map (fun block -> block.Block.uuid)
  |> Uuid_refs_types.unique_preserve_order

let result_ids ids =
  Edn_util.map_vec
    (Vec.of_array
       [|
         ( kw "result",
           Edn_util.vector_vec (ids |> Vec.map (fun id -> Edn_util.int64 id)) );
       |])

let lookup_of_tag = function
  | Selector.Tag_id id -> Edn_util.int64 id
  | Tag_name name -> Edn_util.string (normalized_lookup_name name)
  | Tag_ident ident -> Edn_util.any ident
  | Tag_uuid uuid ->
      vector_vec (Vec.of_array [| kw "block/uuid"; Edn_util.uuid uuid |])

let tag_entity value =
  match Option.bind (Edn_util.get value "block/tags") Edn_util.as_seq with
  | Some tags ->
      Vec.exists
        (fun tag ->
          match
            Option.bind (Edn_util.get tag "db/ident") Edn_util.as_string_like
          with
          | Some "logseq.class/Tag" -> true
          | _ -> false)
        tags
  | None -> false

let resolve_tag_entity invoke_config repo tag =
  let open Cli_effect in
  match tag with
  | Selector.Tag_name name ->
      bind (find_tag_by_name invoke_config repo name) (function
        | Some entity when Option.is_some (id_of_entity entity) ->
            pure (Entity.of_value entity)
        | _ -> failwith "tag not found")
  | _ ->
      bind
        (pull_entity invoke_config repo tag_selector (lookup_of_tag tag))
        (fun entity ->
          match first_entity entity with
          | Some entity
            when Option.is_some (id_of_entity entity) && tag_entity entity ->
              pure (Entity.of_value entity)
          | Some _ -> failwith "tag not found"
          | None -> failwith "tag not found")

let resolve_tags config repo tags =
  if Vec.is_empty tags then Cli_effect.pure Vec.empty
  else
    let open Cli_effect in
    bind (Server_runtime.ensure_server config repo ~create_empty_db:false)
      (function
      | Error err -> failwith err.message
      | Ok invoke_config ->
          all (Vec.map (resolve_tag_entity invoke_config repo) tags))

let lookup_property_entity invoke_config repo = function
  | Property.Key_id id ->
      pull_entity invoke_config repo property_entity_selector
        (Edn_util.int64 id)
  | Key_ident ident ->
      pull_entity invoke_config repo property_entity_selector
        (vector_vec (Vec.of_array [| kw "db/ident"; Edn_util.any ident |]))
  | Key_name name ->
      let open Cli_effect in
      bind
        (pull_property_by_name invoke_config repo name property_entity_selector)
        (fun result ->
          match first_entity result with
          | Some entity when Option.is_some (id_of_entity entity) -> pure entity
          | _ ->
              let ident = Edn_util.keyword_t name in
              pull_entity invoke_config repo property_entity_selector
                (vector_vec
                   (Vec.of_array [| kw "db/ident"; Edn_util.any ident |])))

let resolve_property_assignment invoke_config repo assignment =
  let open Cli_effect in
  bind (lookup_property_entity invoke_config repo assignment.Property.key)
    (fun entity ->
      match
        ( id_of_entity entity,
          ident_of_entity entity,
          Edn_util.get entity "logseq.property/type" )
      with
      | Some _, Some ident, Some _ ->
          pure { assignment with Property.key = Property.Key_ident ident }
      | _ -> failwith "property not found")

let resolve_properties config repo properties =
  if Vec.is_empty properties then Cli_effect.pure Vec.empty
  else
    let open Cli_effect in
    bind (Server_runtime.ensure_server config repo ~create_empty_db:false)
      (function
      | Error err -> failwith err.message
      | Ok invoke_config ->
          all
            (Vec.map
               (resolve_property_assignment invoke_config repo)
               properties))

let resolve_created_ids config repo blocks insert_result =
  let open Cli_effect in
  let uuids =
    let uuids = collect_uuids_from_value insert_result in
    if Vec.is_empty uuids then collect_action_block_uuids blocks
    else Uuid_refs_types.unique_preserve_order uuids
  in
  let rec loop acc remaining =
    match Vec.pop_front remaining with
    | None -> pure (Ok acc)
    | Some (uuid, rest) ->
        bind
          (pull_entity config repo
             (vector_vec (Vec.of_array [| kw "db/id"; kw "block/uuid" |]))
             (vector_vec
                (Vec.of_array [| kw "block/uuid"; Edn_util.uuid uuid |])))
          (fun entity ->
            match id_of_entity entity with
            | Some id -> loop (Vec.push_back acc id) rest
            | None ->
                pure
                  (Error
                     (Error.make Error.Add_id_resolution_failed
                        "unable to resolve created ids")))
  in
  loop Vec.empty uuids

let target_not_found_error () =
  Error.make Error.Target_not_found "target block not found"

let resolve_created_ids_or_target_error config repo target_uuid blocks
    insert_result =
  let open Cli_effect in
  bind (resolve_created_ids config repo blocks insert_result) (function
    | Ok ids -> pure (Ok ids)
    | Error err when err.Error.code = Error.Add_id_resolution_failed ->
        bind
          (pull_entity config repo
             (vector_vec (Vec.of_array [| kw "db/id"; kw "block/uuid" |]))
             (vector_vec
                (Vec.of_array [| kw "block/uuid"; Edn_util.uuid target_uuid |])))
          (fun target ->
            if Option.is_some (id_of_entity target) then pure (Error err)
            else pure (Error (target_not_found_error ())))
    | Error err -> pure (Error err))

let property_key_to_value = function
  | Property.Key_ident ident -> Edn_util.any ident
  | Key_id id -> Edn_util.int64 id
  | Key_name name -> Edn_util.string name

let metadata_ops block_uuids status tags properties =
  let uuid_values =
    Edn_util.vector_vec (block_uuids |> Vec.map (fun uuid -> Edn_util.uuid uuid))
  in
  let status_ops =
    match (status, block_uuids) with
    | Some status, uuids when not (Vec.is_empty uuids) ->
        Vec.singleton
          (Edn_util.vector_vec
             (Vec.of_array
                [|
                  kw "batch-set-property";
                  Edn_util.vector_vec
                    (Vec.of_array
                       [|
                         uuid_values;
                         kw "logseq.property/status";
                         Edn_util.any status;
                         Edn_util.map_vec Vec.empty;
                       |]);
                |]))
    | _ -> Vec.empty
  in
  let tag_ops =
    tags
    |> Vec.filter_map (fun tag -> tag.Entity.id)
    |> Uuid_refs_types.unique_preserve_order
    |> 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;
                    |]);
             |]))
  in
  let property_ops =
    Vec.map
      (fun assignment ->
        Edn_util.vector_vec
          (Vec.of_array
             [|
               kw "batch-set-property";
               Edn_util.vector_vec
                 (Vec.of_array
                    [|
                      uuid_values;
                      property_key_to_value assignment.Property.key;
                      assignment.value;
                      Edn_util.map_vec Vec.empty;
                    |]);
             |]))
      properties
  in
  if Vec.is_empty block_uuids then Vec.empty
  else Vec.append status_ops (Vec.append tag_ops property_ops)

let page_ref_value entity fallback_title =
  match uuid_of_entity entity with
  | None -> None
  | Some uuid ->
      let fields =
        Vec.of_array
          [|
            (kw "block/uuid", Edn_util.uuid uuid);
            ( kw "block/title",
              Edn_util.string
                (Option.value
                   (Edn_util.get_string entity "block/title")
                   ~default:fallback_title) );
          |]
      in
      let fields =
        match Edn_util.get_string entity "block/name" with
        | Some name ->
            Vec.push_front fields (kw "block/name", Edn_util.string name)
        | None -> fields
      in
      Some (Edn_util.map_vec fields)

let resolve_title_page_refs invoke_config repo title =
  let open Cli_effect in
  let page_names = extract_page_refs title in
  let rec loop acc remaining =
    match Vec.pop_front remaining with
    | None -> pure (Ok acc)
    | Some (page_name, rest) ->
        bind (ensure_page_entity invoke_config repo page_name) (function
          | Error err -> pure (Error err)
          | Ok entity -> (
              match page_ref_value entity page_name with
              | Some ref_value -> loop (Vec.push_back acc ref_value) rest
              | None -> pure (Error (page_not_found ()))))
  in
  loop Vec.empty page_names

let rec resolve_block_title_page_refs invoke_config repo block =
  let open Cli_effect in
  let title_refs =
    match block.Block.title with
    | Some title -> resolve_title_page_refs invoke_config repo title
    | None -> pure (Ok Vec.empty)
  in
  bind title_refs (function
    | Error err -> pure (Error err)
    | Ok refs ->
        let rec resolve_children acc remaining =
          match Vec.pop_front remaining with
          | None -> pure (Ok acc)
          | Some (child, rest) ->
              bind (resolve_block_title_page_refs invoke_config repo child)
                (function
                | Error err -> pure (Error err)
                | Ok child_refs ->
                    resolve_children (Vec.append acc child_refs) rest)
        in
        bind (resolve_children Vec.empty block.Block.children) (function
          | Error err -> pure (Error err)
          | Ok child_refs ->
              let own_refs =
                match (block.Block.uuid, refs) with
                | Some uuid, refs when not (Vec.is_empty refs) ->
                    Vec.singleton (uuid, refs)
                | _ -> Vec.empty
              in
              pure (Ok (Vec.append own_refs child_refs))))

let resolve_blocks_title_page_refs invoke_config repo blocks =
  let open Cli_effect in
  let rec loop acc remaining =
    match Vec.pop_front remaining with
    | None -> pure (Ok acc)
    | Some (block, rest) ->
        bind (resolve_block_title_page_refs invoke_config repo block) (function
          | Error err -> pure (Error err)
          | Ok refs -> loop (Vec.append acc refs) rest)
  in
  loop Vec.empty blocks

let execute_add_block 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_add_target invoke_config action) (function
          | Error err ->
              pure (Cli_result.error ~command:Command_id.Upsert_block mode err)
          | Ok target_uuid ->
              bind (resolve_tags config action.repo action.tags) (fun tags ->
                  bind (resolve_properties config action.repo action.properties)
                    (fun properties ->
                      bind
                        (resolve_blocks_title_page_refs invoke_config
                           action.repo action.blocks) (function
                        | Error err ->
                            pure
                              (Cli_result.error ~command:Command_id.Upsert_block
                                 mode err)
                        | Ok refs_by_uuid ->
                            let all_blocks = Block.flatten action.blocks in
                            let block_uuids =
                              Vec.filter_map
                                (fun block -> block.Block.uuid)
                                all_blocks
                              |> Uuid_refs_types.unique_preserve_order
                            in
                            let block_for_insert block =
                              {
                                block with
                                Block.parent = None;
                                children = Vec.empty;
                              }
                            in
                            let block_value_for_insert block =
                              let value =
                                Edn_util.any
                                  (Block.to_value (block_for_insert block))
                              in
                              match block.Block.uuid with
                              | Some uuid -> (
                                  match Vec.assoc_opt uuid refs_by_uuid with
                                  | Some refs ->
                                      Edn_util.assoc "block/refs"
                                        (Edn_util.vector_vec refs) value
                                  | None -> value)
                              | None -> value
                            in
                            let insert_blocks target_uuid pos blocks =
                              let insert_op =
                                Edn_util.vector_vec
                                  (Vec.of_array
                                     [|
                                       kw "insert-blocks";
                                       Edn_util.vector_vec
                                         (Vec.of_array
                                            [|
                                              Edn_util.vector_vec
                                                (blocks
                                                |> Vec.map (fun block ->
                                                    block_value_for_insert block)
                                                );
                                              Edn_util.uuid target_uuid;
                                              insert_opts pos;
                                            |]);
                                     |])
                              in
                              apply_outliner_ops invoke_config action.repo
                                (Vec.singleton insert_op)
                            in
                            let rec insert_tree target_uuid pos blocks =
                              if Vec.is_empty blocks then pure Edn_util.nil
                              else
                                bind (insert_blocks target_uuid pos blocks)
                                  (fun insert_result ->
                                    let rec insert_children acc remaining =
                                      match Vec.pop_front remaining with
                                      | None -> pure acc
                                      | Some (block, rest) -> (
                                          match block.Block.uuid with
                                          | None -> insert_children acc rest
                                          | Some uuid ->
                                              bind
                                                (insert_tree uuid
                                                   Block.Last_child
                                                   block.Block.children)
                                                (fun child_result ->
                                                  let acc =
                                                    if Edn_util.is_null acc then
                                                      child_result
                                                    else acc
                                                  in
                                                  insert_children acc rest))
                                    in
                                    insert_children insert_result blocks)
                            in
                            bind
                              (insert_tree target_uuid action.pos action.blocks)
                              (fun insert_result ->
                                let metadata_ops =
                                  metadata_ops block_uuids action.status tags
                                    properties
                                in
                                bind
                                  (if Vec.is_empty metadata_ops then
                                     pure Edn_util.nil
                                   else
                                     apply_outliner_ops invoke_config
                                       action.repo metadata_ops)
                                  (fun _metadata_result ->
                                    bind
                                      (resolve_created_ids_or_target_error
                                         invoke_config action.repo target_uuid
                                         all_blocks insert_result) (function
                                      | Error err ->
                                          pure
                                            (Cli_result.error
                                               ~command:Command_id.Upsert_block
                                               mode err)
                                      | Ok ids ->
                                          pure
                                            (Cli_result.ok
                                               ~command:Command_id.Upsert_block
                                               mode
                                               (Raw (result_ids ids)))))))))))