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>

cli/lib/auth_command.ml

@@ -0,0 +1,94 @@
+open Cli_effect.Infix
+
+type parsed = Parsed_login | Parsed_logout
+type action = Login | Logout
+
+let command_id = function
+  | Parsed_login -> Command_id.Login
+  | Parsed_logout -> Logout
+
+let validate_parsed _ = Ok ()
+
+let build ?registry:_ _ _ = function
+  | Parsed_login -> Ok Login
+  | Parsed_logout -> Ok Logout
+
+let login_value (result : Auth_state.login_result) =
+  let fields =
+    Vec.of_array
+      [|
+        (Edn_util.keyword "auth-path", Edn_util.string result.auth_path);
+        (Edn_util.keyword "authorize-url", Edn_util.string result.authorize_url);
+        (Edn_util.keyword "opened", Edn_util.bool result.opened);
+        ( Edn_util.keyword "updated-at",
+          Edn_util.int64 (Time.time_to_epoch_ms result.updated_at) );
+      |]
+  in
+  let fields =
+    match result.email with
+    | Some email ->
+        Vec.push_back fields (Edn_util.keyword "email", Edn_util.string email)
+    | None -> fields
+  in
+  let fields =
+    match result.sub with
+    | Some sub ->
+        Vec.push_back fields (Edn_util.keyword "sub", Edn_util.string sub)
+    | None -> fields
+  in
+  Edn_util.map_vec fields
+
+let logout_value (result : Auth_state.logout_result) =
+  Edn_util.map_vec
+    (Vec.of_array
+       [|
+         (Edn_util.keyword "auth-path", Edn_util.string result.auth_path);
+         (Edn_util.keyword "deleted", Edn_util.bool result.deleted);
+         (Edn_util.keyword "logout-url", Edn_util.string result.logout_url);
+         (Edn_util.keyword "opened", Edn_util.bool result.opened);
+         ( Edn_util.keyword "logout-completed",
+           Edn_util.bool result.logout_completed );
+       |])
+
+let execute_with_mode action config mode =
+  match action with
+  | Login -> (
+      Auth_state.login config >>= function
+      | Ok result ->
+          Cli_effect.pure
+            (Cli_result.ok ~command:Command_id.Login mode
+               (Raw (login_value result)))
+      | Error err ->
+          Cli_effect.pure (Output_mode.error ~command:Command_id.Login mode err)
+      )
+  | Logout -> (
+      Auth_state.logout config >>= function
+      | Ok result ->
+          Cli_effect.pure
+            (Cli_result.ok ~command:Command_id.Logout mode
+               (Raw (logout_value result)))
+      | Error err ->
+          Cli_effect.pure
+            (Output_mode.error ~command:Command_id.Logout mode err))
+
+let meta id doc =
+  {
+    Command_registry.id;
+    path = Command_id.to_path id;
+    doc;
+    long_doc = None;
+    examples = Vec.empty;
+    options = Vec.empty;
+    category = Command_registry.Authentication;
+    requires_graph = Command_id.requires_graph id;
+    requires_auth = Command_id.requires_auth id;
+    write_command = Command_id.is_write id;
+    human_table_headers_order = Vec.empty;
+  }
+
+let metadata () =
+  Vec.of_array [| meta Command_id.Login "Login"; meta Logout "Logout" |]
+
+let execute action config =
+  let (Output.Mode.Packed mode) = Output_mode.for_config config in
+  execute_with_mode action config mode

cli/lib/auth_state.ml

@@ -0,0 +1,766 @@
+open Cli_effect.Infix
+
+type auth_data = {
+  provider : string;
+  id_token : string option;
+  access_token : string option;
+  refresh_token : string option;
+  expires_at : Js.Date.t option;
+  sub : string option;
+  email : Cli_primitive.email option;
+  updated_at : Js.Date.t;
+}
+
+type login_result = {
+  auth_path : Cli_primitive.path;
+  authorize_url : Cli_primitive.url;
+  opened : bool;
+  email : Cli_primitive.email option;
+  sub : string option;
+  updated_at : Js.Date.t;
+}
+
+type logout_result = {
+  auth_path : Cli_primitive.path;
+  deleted : bool;
+  logout_url : Cli_primitive.url;
+  opened : bool;
+  logout_completed : bool;
+}
+
+let default_auth_path () =
+  Filename.concat
+    (Filename.concat
+       (Sys.getenv_opt "HOME" |> Option.value ~default:".")
+       "logseq")
+    "auth.json"
+
+let auth_path config =
+  Option.value config.Cli_config.auth_path ~default:(default_auth_path ())
+
+let rec mkdir_p path =
+  if path = "" || path = Filename.dirname path || Cli_unix.file_exists path then
+    ()
+  else (
+    mkdir_p (Filename.dirname path);
+    Cli_unix.mkdir path 0o755)
+
+let read_file = Cli_unix.read_text_file
+
+let http_error_message status body =
+  if String.trim body = "" then
+    "http request failed (" ^ string_of_int status ^ ")"
+  else
+    "http request failed (" ^ string_of_int status ^ ")\nhttp response: " ^ body
+
+let http_request ~(method_ : Fetch.requestMethod) ~url ~headers ~body
+    ~timeout_span =
+  Cli_platform.HTTP.request ?timeout_span method_ url ~headers ~body
+  >>= fun (response, body) ->
+  let status = Fetch.Response.status response in
+  if status >= 200 && status <= 299 then Cli_effect.pure body
+  else Cli_effect.error (Failure (http_error_message status body))
+
+let auth_json data =
+  let object_ = Js.Dict.empty () in
+  let set_string key value = Js.Dict.set object_ key (Js.Json.string value) in
+  let set_int key value =
+    Js.Dict.set object_ key (Js.Json.number (Int64.to_float value))
+  in
+  let set_opt_string key = Option.iter (set_string key) in
+  let set_opt_time key =
+    Option.iter (fun value -> set_int key (Time.time_to_epoch_ms value))
+  in
+  set_string "provider" data.provider;
+  set_int "updated-at" (Time.time_to_epoch_ms data.updated_at);
+  set_opt_string "id-token" data.id_token;
+  set_opt_string "access-token" data.access_token;
+  set_opt_string "refresh-token" data.refresh_token;
+  set_opt_time "expires-at" data.expires_at;
+  set_opt_string "sub" data.sub;
+  set_opt_string "email" data.email;
+  Js.Json.stringify (Js.Json.object_ object_) ^ "\n"
+
+let first_string_field object_ keys =
+  keys |> Vec.find_map (Json_util.string_field object_)
+
+let first_int64_field object_ keys =
+  keys |> Vec.find_map (Json_util.int64_field object_)
+
+let parse_auth_json text =
+  let object_ = Json_util.object_of_json_string text in
+  let id_token =
+    Option.bind object_ (fun object_ ->
+        first_string_field object_ (Vec.of_array [| "id-token"; "id_token" |]))
+  in
+  let access_token =
+    Option.bind object_ (fun object_ ->
+        first_string_field object_
+          (Vec.of_array [| "access-token"; "access_token" |]))
+  in
+  let refresh_token =
+    Option.bind object_ (fun object_ ->
+        first_string_field object_
+          (Vec.of_array [| "refresh-token"; "refresh_token" |]))
+  in
+  let provider =
+    Option.bind object_ (fun object_ ->
+        first_string_field object_ (Vec.singleton "provider"))
+  in
+  match (provider, id_token, access_token, refresh_token) with
+  | None, None, None, None ->
+      Error (Error.make Error.Invalid_auth_file "invalid auth file")
+  | _, _, _, _ ->
+      let provider = Option.value provider ~default:"cognito" in
+      Ok
+        {
+          provider;
+          id_token;
+          access_token;
+          refresh_token;
+          expires_at =
+            Option.bind object_ (fun object_ ->
+                Option.map Time.time_of_epoch_ms
+                  (first_int64_field object_
+                     (Vec.of_array [| "expires-at"; "expires_at" |])));
+          sub =
+            Option.bind object_ (fun object_ ->
+                first_string_field object_ (Vec.singleton "sub"));
+          email =
+            Option.bind object_ (fun object_ ->
+                first_string_field object_ (Vec.singleton "email"));
+          updated_at =
+            Option.value
+              (Option.bind object_ (fun object_ ->
+                   Option.map Time.time_of_epoch_ms
+                     (first_int64_field object_
+                        (Vec.of_array [| "updated-at"; "updated_at" |]))))
+              ~default:Time.epoch;
+        }
+
+let jwt_payload token =
+  let parts = Vec.split_on_char '.' token in
+  if Vec.length parts = 3 then
+    Ok (Cli_platform.Crypto.base64url_decode (Vec.nth parts 1))
+  else Error (Error.make Error.Invalid_auth_token "invalid auth token")
+
+let claims_of_id_token id_token =
+  Error.bind (jwt_payload id_token) (fun payload ->
+      let object_ = Json_util.object_of_json_string payload in
+      Ok
+        ( Option.bind object_ (fun object_ ->
+              first_string_field object_ (Vec.singleton "sub")),
+          Option.bind object_ (fun object_ ->
+              first_string_field object_ (Vec.singleton "email")),
+          Option.bind object_ (fun object_ ->
+              Option.map
+                (fun exp -> Time.time_of_epoch_ms (Int64.mul exp 1_000L))
+                (first_int64_field object_ (Vec.singleton "exp"))) ))
+
+let auth_path_context path =
+  Edn_util.map_vec
+    (Vec.of_array [| (Edn_util.keyword "auth-path", Edn_util.string path) |])
+
+let read_auth_file config =
+  let path = auth_path config in
+  Cli_effect.pure
+    (if not (Cli_unix.file_exists path) then Ok None
+     else
+       try Error.map (fun data -> Some data) (parse_auth_json (read_file path))
+       with exn ->
+         Error
+           (Error.make ~context:(auth_path_context path) Error.Invalid_auth_file
+              (Printexc.to_string exn)))
+
+let write_auth_file config data =
+  let path = auth_path config in
+  Cli_effect.pure
+    (try
+       mkdir_p (Filename.dirname path);
+       Cli_unix.write_text_file path (auth_json data);
+       (try Cli_unix.chmod path 0o600 with Cli_unix.Cli_unix_error _ -> ());
+       Ok data
+     with exn ->
+       Error
+         (Error.make ~context:(auth_path_context path)
+            Error.Auth_file_write_failed (Printexc.to_string exn)))
+
+let delete_auth_file config =
+  let path = auth_path config in
+  Cli_effect.pure
+    (try
+       if Cli_unix.file_exists path then Cli_unix.remove_tree path;
+       Ok ()
+     with exn ->
+       Error
+         (Error.make ~context:(auth_path_context path)
+            Error.Auth_file_delete_failed (Printexc.to_string exn)))
+
+let expired_auth auth =
+  match auth.expires_at with
+  | Some expires_at -> Time.compare_time expires_at (Time.now ()) <= 0
+  | None -> true
+
+let missing_auth config message =
+  Error.make ~hint:"Run `logseq login` first."
+    ~context:(auth_path_context (auth_path config))
+    Error.Missing_auth message
+
+let config_auth config =
+  if
+    Option.is_some config.Cli_config.id_token
+    || Option.is_some config.access_token
+    || Option.is_some config.refresh_token
+  then
+    Some
+      {
+        provider = "cognito";
+        id_token = config.id_token;
+        access_token = config.access_token;
+        refresh_token = config.refresh_token;
+        expires_at = None;
+        sub = None;
+        email = None;
+        updated_at = Time.now ();
+      }
+  else None
+
+let raw_config_string config keys =
+  match config.Cli_config.raw_file_config with
+  | None -> None
+  | Some value -> Vec.find_map (Edn_util.get_string value) keys
+
+let default_oauth_domain = "logseq-prod.auth.us-east-1.amazoncognito.com"
+let default_oauth_client_id = "69cs1lgme7p8kbgld8n5kseii6"
+let default_api_http_base = "https://api.logseq.io"
+
+let normalize_base_url value =
+  let value = String.trim value in
+  if value <> "" && value.[String.length value - 1] = '/' then
+    String.sub value 0 (String.length value - 1)
+  else value
+
+let oauth_domain_base config =
+  match
+    raw_config_string config (Vec.of_array [| "oauth-domain"; "domain" |])
+  with
+  | Some domain when String.trim domain <> "" -> "https://" ^ String.trim domain
+  | _ -> "https://" ^ default_oauth_domain
+
+let raw_http_base config = raw_config_string config (Vec.singleton "http-base")
+
+let configured_http_base config =
+  match raw_http_base config with
+  | Some base when String.trim base <> "" -> Some base
+  | _ -> (
+      match config.Cli_config.http_base with
+      | Some base
+        when String.trim base <> ""
+             && normalize_base_url base <> default_api_http_base ->
+          Some base
+      | _ -> None)
+
+let oauth_endpoint_base config =
+  Option.value (configured_http_base config) ~default:(oauth_domain_base config)
+
+let token_endpoint config =
+  match
+    raw_config_string config
+      (Vec.of_array [| "oauth-token-endpoint"; "token-endpoint" |])
+  with
+  | Some endpoint when String.trim endpoint <> "" -> Some endpoint
+  | _ -> Some (normalize_base_url (oauth_endpoint_base config) ^ "/oauth2/token")
+
+let logout_endpoint config =
+  match
+    raw_config_string config
+      (Vec.of_array [| "oauth-logout-endpoint"; "logout-endpoint" |])
+  with
+  | Some endpoint when String.trim endpoint <> "" -> Some endpoint
+  | _ -> Some (normalize_base_url (oauth_endpoint_base config) ^ "/logout")
+
+let oauth_client_id config =
+  match
+    raw_config_string config (Vec.of_array [| "oauth-client-id"; "client-id" |])
+  with
+  | Some client_id when String.trim client_id <> "" -> Some client_id
+  | _ -> Some default_oauth_client_id
+
+let authorize_endpoint config =
+  match
+    raw_config_string config
+      (Vec.of_array [| "oauth-authorize-endpoint"; "authorize-endpoint" |])
+  with
+  | Some endpoint when String.trim endpoint <> "" -> Some endpoint
+  | _ ->
+      Some
+        (normalize_base_url (oauth_endpoint_base config) ^ "/oauth2/authorize")
+
+let oauth_scope config =
+  Option.value
+    (raw_config_string config (Vec.of_array [| "oauth-scope"; "scope" |]))
+    ~default:"email openid phone"
+
+let raw_config_bool config keys ~default =
+  match config.Cli_config.raw_file_config with
+  | None -> default
+  | Some value -> (
+      match Vec.find_map (Edn_util.get value) keys with
+      | Some value when Option.is_some (Edn_util.as_bool value) ->
+          Option.get (Edn_util.as_bool value)
+      | Some value when Option.is_some (Edn_util.as_string value) ->
+          let value = Option.get (Edn_util.as_string value) in
+          String.lowercase_ascii (String.trim value) = "true"
+      | _ -> default)
+
+let replace_char ~needle ~replacement value =
+  value |> Vec.split_on_char needle |> Vec.string_concat replacement
+
+let form_encode value =
+  value |> Js.Global.encodeURIComponent
+  |> replace_char ~needle:'!' ~replacement:"%21"
+  |> replace_char ~needle:'\'' ~replacement:"%27"
+  |> replace_char ~needle:'(' ~replacement:"%28"
+  |> replace_char ~needle:')' ~replacement:"%29"
+  |> replace_char ~needle:'*' ~replacement:"%2A"
+
+let form_body fields =
+  fields
+  |> Vec.map (fun (key, value) -> form_encode key ^ "=" ^ form_encode value)
+  |> Vec.string_concat "&"
+
+let query_string fields =
+  fields
+  |> Vec.map (fun (key, value) -> form_encode key ^ "=" ^ form_encode value)
+  |> Vec.string_concat "&"
+
+let random_base64url size = Cli_platform.Crypto.random_base64url size
+let pkce_challenge verifier = Sha256.base64url verifier
+
+let raw_or_random config keys size =
+  match raw_config_string config keys with
+  | Some value when String.trim value <> "" -> value
+  | _ -> random_base64url size
+
+let refreshed_auth_of_body current body =
+  match Json_util.object_of_json_string body with
+  | None ->
+      Error
+        (Error.make Error.Missing_id_token
+           "auth token response missing id_token")
+  | Some object_ -> (
+      match
+        first_string_field object_ (Vec.of_array [| "id_token"; "id-token" |])
+      with
+      | None ->
+          Error
+            (Error.make Error.Missing_id_token
+               "auth token response missing id_token")
+      | Some id_token ->
+          Error.bind (claims_of_id_token id_token)
+            (fun (sub, email, expires_at) ->
+              Ok
+                {
+                  provider = "cognito";
+                  id_token = Some id_token;
+                  access_token =
+                    first_string_field object_
+                      (Vec.of_array [| "access_token"; "access-token" |]);
+                  refresh_token =
+                    (match
+                       first_string_field object_
+                         (Vec.of_array [| "refresh_token"; "refresh-token" |])
+                     with
+                    | Some _ as token -> token
+                    | None -> current.refresh_token);
+                  expires_at;
+                  sub;
+                  email;
+                  updated_at = Time.now ();
+                }))
+
+let refresh_auth config data =
+  match data.refresh_token with
+  | None ->
+      Cli_effect.pure (Error (missing_auth config "missing refresh token"))
+  | Some refresh_token -> (
+      match token_endpoint config with
+      | None ->
+          Cli_effect.pure
+            (Error
+               (Error.make ~hint:"Run `logseq login` first."
+                  Error.Auth_refresh_failed
+                  "auth token endpoint is not configured"))
+      | Some url ->
+          let fields =
+            Vec.of_array
+              [|
+                ("grant_type", "refresh_token"); ("refresh_token", refresh_token);
+              |]
+          in
+          let fields =
+            match oauth_client_id config with
+            | Some client_id -> Vec.push_back fields ("client_id", client_id)
+            | None -> fields
+          in
+          Cli_effect.catch
+            (Cli_effect.map
+               (fun body -> refreshed_auth_of_body data body)
+               (http_request ~method_:Fetch.Post ~url
+                  ~headers:
+                    (Vec.of_array
+                       [|
+                         ("Content-Type", "application/x-www-form-urlencoded");
+                         ("Accept", "application/json");
+                       |])
+                  ~body:(form_body fields)
+                  ~timeout_span:(Some config.timeout_span)))
+            (fun exn ->
+              Cli_effect.pure
+                (Error
+                   (Error.make ~hint:"Run `logseq login` first."
+                      ~context:
+                        (Edn_util.map_vec
+                           (Vec.of_array
+                              [|
+                                ( Edn_util.keyword "auth-path",
+                                  Edn_util.string (auth_path config) );
+                                ( Edn_util.keyword "error",
+                                  Edn_util.string (Printexc.to_string exn) );
+                              |]))
+                      Error.Auth_refresh_failed "auth refresh failed"))))
+
+let auth_code_exchange config ~code ~redirect_uri ~code_verifier =
+  match token_endpoint config with
+  | None ->
+      Cli_effect.pure
+        (Error
+           (Error.make ~hint:"Run `logseq login` first."
+              Error.Auth_code_exchange_failed
+              "auth token endpoint is not configured"))
+  | Some url ->
+      let fields =
+        Vec.of_array
+          [|
+            ("grant_type", "authorization_code");
+            ("code", code);
+            ("redirect_uri", redirect_uri);
+            ("code_verifier", code_verifier);
+          |]
+      in
+      let fields =
+        match oauth_client_id config with
+        | Some client_id -> Vec.push_back fields ("client_id", client_id)
+        | None -> fields
+      in
+      Cli_effect.catch
+        (Cli_effect.map
+           (fun body ->
+             refreshed_auth_of_body
+               {
+                 provider = "cognito";
+                 id_token = None;
+                 access_token = None;
+                 refresh_token = None;
+                 expires_at = None;
+                 sub = None;
+                 email = None;
+                 updated_at = Time.now ();
+               }
+               body)
+           (http_request ~method_:Fetch.Post ~url
+              ~headers:
+                (Vec.of_array
+                   [|
+                     ("Content-Type", "application/x-www-form-urlencoded");
+                     ("Accept", "application/json");
+                   |])
+              ~body:(form_body fields) ~timeout_span:(Some config.timeout_span)))
+        (fun exn ->
+          Cli_effect.pure
+            (Error
+               (Error.make ~hint:"Run `logseq login` first."
+                  ~context:
+                    (Edn_util.map_vec
+                       (Vec.of_array
+                          [|
+                            ( Edn_util.keyword "auth-path",
+                              Edn_util.string (auth_path config) );
+                            ( Edn_util.keyword "error",
+                              Edn_util.string (Printexc.to_string exn) );
+                          |]))
+                  Error.Auth_code_exchange_failed
+                  "authorization code exchange failed")))
+
+let redirect_path = "/auth/callback"
+let callback_host = "localhost"
+let callback_port = 8765
+
+let split_once c value =
+  match String.index_opt value c with
+  | None -> (value, "")
+  | Some idx ->
+      ( String.sub value 0 idx,
+        String.sub value (idx + 1) (String.length value - idx - 1) )
+
+let url_decode value =
+  try
+    value
+    |> replace_char ~needle:'+' ~replacement:" "
+    |> Js.Global.decodeURIComponent
+  with _ -> value
+
+let query_params query =
+  Vec.split_on_char '&' query
+  |> Vec.filter_map (fun part ->
+      if part = "" then None
+      else
+        let key, value = split_once '=' part in
+        Some (url_decode key, url_decode value))
+
+let login_callback_response status body : Cli_platform.login_callback_response =
+  { status; body }
+
+let callback_uri path =
+  "http://" ^ callback_host ^ ":" ^ string_of_int callback_port ^ path
+
+let callback_result_of_target ~state = function
+  | None ->
+      ( login_callback_response 400 "Invalid request",
+        Error
+          (Error.make Error.Invalid_callback_request
+             "invalid login callback request") )
+  | Some target -> (
+      let path, query = split_once '?' target in
+      let params = query_params query in
+      let param key = Vec.assoc_opt key params in
+      match (path, param "error", param "state", param "code") with
+      | path, _, _, _ when path <> redirect_path ->
+          ( login_callback_response 404 "Not found",
+            Error
+              (Error.make Error.Login_callback_not_found
+                 "login callback path not found") )
+      | _, Some oauth_error, _, _ ->
+          ( login_callback_response 400
+              "Login failed. You can return to the CLI.",
+            Error
+              (Error.make
+                 ~context:
+                   (Edn_util.map_vec
+                      (Vec.of_array
+                         [|
+                           ( Edn_util.keyword "oauth-error",
+                             Edn_util.string oauth_error );
+                         |]))
+                 Error.Login_callback_error
+                 "login callback returned oauth error") )
+      | _, _, Some callback_state, _ when callback_state <> state ->
+          ( login_callback_response 400
+              "Login failed due to state mismatch. Return to the CLI and retry.",
+            Error
+              (Error.make Error.Invalid_callback_state
+                 "login callback state mismatch") )
+      | _, _, _, Some code when String.trim code <> "" ->
+          ( login_callback_response 200
+              "Login successful. You can return to the CLI.",
+            Ok code )
+      | _ ->
+          ( login_callback_response 400
+              "Login failed because the callback did not include a code.",
+            Error
+              (Error.make Error.Missing_callback_code
+                 "missing authorization code") ))
+
+let open_browser config url =
+  if
+    not
+      (raw_config_bool config
+         (Vec.of_array [| "open-browser"; "open-browser?" |])
+         ~default:true)
+  then Ok false
+  else if Cli_unix.open_url url then Ok true
+  else Error (Error.make Error.Browser_open_failed "failed to open browser")
+
+let resolve_auth config =
+  match config_auth config with
+  | Some auth -> Cli_effect.pure (Ok auth)
+  | None -> (
+      read_auth_file config >>= function
+      | Error err -> Cli_effect.pure (Error err)
+      | Ok None -> Cli_effect.pure (Error (missing_auth config "missing auth"))
+      | Ok (Some auth) ->
+          if expired_auth auth then
+            refresh_auth config auth >>= function
+            | Error err -> Cli_effect.pure (Error err)
+            | Ok refreshed -> write_auth_file config refreshed
+          else Cli_effect.pure (Ok auth))
+
+let login config =
+  match authorize_endpoint config with
+  | None ->
+      Cli_effect.pure
+        (Error
+           (Error.make Error.Login_not_configured
+              "oauth authorize endpoint is not configured"))
+  | Some authorize_endpoint -> (
+      match oauth_client_id config with
+      | None ->
+          Cli_effect.pure
+            (Error
+               (Error.make Error.Login_not_configured
+                  "oauth client id is not configured"))
+      | Some client_id -> (
+          let state =
+            raw_or_random config (Vec.of_array [| "oauth-state"; "state" |]) 24
+          in
+          let code_verifier =
+            raw_or_random config
+              (Vec.of_array [| "oauth-code-verifier"; "code-verifier" |])
+              48
+          in
+          let code_challenge =
+            match
+              raw_config_string config
+                (Vec.of_array [| "oauth-code-challenge"; "code-challenge" |])
+            with
+            | Some value when String.trim value <> "" -> value
+            | _ -> pkce_challenge code_verifier
+          in
+          let redirect_uri = callback_uri redirect_path in
+          let authorize_url =
+            authorize_endpoint ^ "?"
+            ^ query_string
+                (Vec.of_array
+                   [|
+                     ("response_type", "code");
+                     ("client_id", client_id);
+                     ("scope", oauth_scope config);
+                     ("redirect_uri", redirect_uri);
+                     ("state", state);
+                     ("code_challenge", code_challenge);
+                     ("code_challenge_method", "S256");
+                   |])
+          in
+          let finish_login opened code =
+            auth_code_exchange config ~code ~redirect_uri ~code_verifier
+            >>= function
+            | Error err -> Cli_effect.pure (Error err)
+            | Ok auth -> (
+                write_auth_file config auth >>= function
+                | Error err -> Cli_effect.pure (Error err)
+                | Ok data ->
+                    Cli_effect.pure
+                      (Ok
+                         {
+                           auth_path = auth_path config;
+                           authorize_url;
+                           opened;
+                           email = data.email;
+                           sub = data.sub;
+                           updated_at = data.updated_at;
+                         }))
+          in
+          let opened_ref = ref false in
+          let browser_open_error = ref None in
+          let on_listen () =
+            match open_browser config authorize_url with
+            | Ok opened ->
+                opened_ref := opened;
+                Cli_effect.pure (Ok ())
+            | Error err ->
+                browser_open_error := Some err;
+                Cli_effect.pure (Error err.Error.message)
+          in
+          let handle_request request =
+            callback_result_of_target ~state request.Cli_platform.target
+          in
+          Cli_platform.login_callback_server ~host:callback_host
+            ~port:callback_port ~timeout_span:config.login_timeout_span
+            ~on_listen ~handle_request
+          >>= function
+          | Ok (Ok code) -> finish_login !opened_ref code
+          | Ok (Error err) -> Cli_effect.pure (Error err)
+          | Error Cli_platform.Login_callback_timeout ->
+              Cli_effect.pure
+                (Error
+                   (Error.make Error.Login_timeout "login callback timed out"))
+          | Error (Cli_platform.Login_callback_server_aborted message) -> (
+              match !browser_open_error with
+              | Some err -> Cli_effect.pure (Error err)
+              | None ->
+                  Cli_effect.pure
+                    (Error
+                       (Error.make
+                          ~context:
+                            (Edn_util.map_vec
+                               (Vec.of_array
+                                  [|
+                                    ( Edn_util.keyword "error",
+                                      Edn_util.string message );
+                                  |]))
+                          Error.Login_callback_server_start_failed
+                          "failed to start login callback server")))
+          | Error (Cli_platform.Login_callback_server_start_failed message) ->
+              Cli_effect.pure
+                (Error
+                   (Error.make
+                      ~context:
+                        (Edn_util.map_vec
+                           (Vec.of_array
+                              [|
+                                ( Edn_util.keyword "error",
+                                  Edn_util.string message );
+                              |]))
+                      Error.Login_callback_server_start_failed
+                      "failed to start login callback server"))))
+
+let logout config =
+  let path = auth_path config in
+  let existed = Cli_unix.file_exists path in
+  match logout_endpoint config with
+  | None ->
+      Cli_effect.pure
+        (Error
+           (Error.make Error.Logout_not_configured
+              "oauth logout endpoint is not configured"))
+  | Some logout_endpoint -> (
+      match oauth_client_id config with
+      | None ->
+          Cli_effect.pure
+            (Error
+               (Error.make Error.Logout_not_configured
+                  "oauth client id is not configured"))
+      | Some client_id -> (
+          let redirect_uri = callback_uri redirect_path in
+          let state =
+            raw_or_random config
+              (Vec.of_array [| "oauth-logout-state"; "logout-state" |])
+              24
+          in
+          let logout_url =
+            logout_endpoint ^ "?"
+            ^ query_string
+                (Vec.of_array
+                   [|
+                     ("response_type", "code");
+                     ("client_id", client_id);
+                     ("redirect_uri", redirect_uri);
+                     ("state", state);
+                     ("scope", oauth_scope config);
+                   |])
+          in
+          let result opened =
+            {
+              auth_path = path;
+              deleted = existed;
+              logout_url;
+              opened;
+              logout_completed = true;
+            }
+          in
+          delete_auth_file config >>= function
+          | Error err -> Cli_effect.pure (Error err)
+          | Ok () -> (
+              match open_browser config logout_url with
+              | Ok opened -> Cli_effect.pure (Ok (result opened))
+              | Error err -> Cli_effect.pure (Error err))))

cli/lib/block.ml

@@ -0,0 +1,119 @@
+type position = First_child | Last_child | Sibling
+
+type t = {
+  id : Cli_primitive.db_id option;
+  uuid : Cli_primitive.uuid option;
+  title : string option;
+  name : string option;
+  order : int option;
+  parent : Selector.block option;
+  page : Selector.page option;
+  tags : Selector.tag Rrbvec.t;
+  properties : Property.assignment Rrbvec.t;
+  children : t Rrbvec.t;
+  raw : Melange_edn_melange.any;
+}
+
+type tree = { root : t }
+
+let position_of_string = function
+  | "first-child" | "first_child" -> Some First_child
+  | "last-child" | "last_child" -> Some Last_child
+  | "sibling" -> Some Sibling
+  | _ -> None
+
+let make ?uuid ?title ?(children = Vec.empty) () =
+  {
+    id = None;
+    uuid;
+    title;
+    name = None;
+    order = None;
+    parent = None;
+    page = None;
+    tags = Vec.empty;
+    properties = Vec.empty;
+    children;
+    raw = Edn_util.nil;
+  }
+
+let of_value raw =
+  {
+    (make ()) with
+    raw;
+    id = Edn_util.get_int64 raw "db/id";
+    uuid = Edn_util.get_string raw "block/uuid";
+    title = Edn_util.get_string raw "block/title";
+  }
+
+let tag_to_value = function
+  | Selector.Tag_id id -> Edn_util.int64 id
+  | Tag_name name -> Edn_util.string name
+  | Tag_ident ident -> Edn_util.any ident
+  | Tag_uuid uuid -> Edn_util.uuid uuid
+
+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 parent_to_value = function
+  | Selector.Block_id id -> Edn_util.int64 id
+  | Block_uuid uuid ->
+      Edn_util.vector_vec
+        (Vec.of_array [| Edn_util.keyword "block/uuid"; Edn_util.uuid uuid |])
+
+let rec to_value t =
+  let fields =
+    Vec.singleton
+      ( Edn_util.keyword "block/title",
+        Edn_util.string (Option.value t.title ~default:"") )
+  in
+  let fields =
+    if Vec.is_empty t.children then fields
+    else
+      Vec.push_back fields
+        ( Edn_util.keyword "block/children",
+          Edn_util.vector_vec
+            (t.children |> Vec.map (fun child -> Edn_util.any (to_value child)))
+        )
+  in
+  let fields =
+    match t.uuid with
+    | Some uuid ->
+        Vec.push_back fields (Edn_util.keyword "block/uuid", Edn_util.uuid uuid)
+    | None -> fields
+  in
+  let fields =
+    match t.id with
+    | Some id ->
+        Vec.push_back fields (Edn_util.keyword "db/id", Edn_util.int64 id)
+    | None -> fields
+  in
+  let fields =
+    match t.parent with
+    | Some parent ->
+        Vec.push_back fields
+          (Edn_util.keyword "block/parent", parent_to_value parent)
+    | None -> fields
+  in
+  let fields =
+    if Vec.is_empty t.tags then fields
+    else
+      Vec.push_back fields
+        ( Edn_util.keyword "block/tags",
+          Edn_util.set_vec (t.tags |> Vec.map tag_to_value) )
+  in
+  let fields =
+    Vec.fold_left
+      (fun fields assignment ->
+        Vec.push_back fields
+          (property_key_to_value assignment.Property.key, assignment.value))
+      fields t.properties
+  in
+  Edn_util.map_t_vec fields
+
+let rec flatten xs =
+  Vec.append xs (Vec.concat_map (fun t -> flatten t.children) xs)
+
+let label t = match t.title with Some _ as x -> x | None -> t.name

cli/lib/cli.ml

@@ -0,0 +1,469 @@
+type app_context = {
+  registry : Command_registry.t;
+  defaults : Cli_config.defaults;
+}
+
+type run_input = {
+  argv : string Rrbvec.t;
+  env : (string * string) Rrbvec.t;
+  cwd : Cli_primitive.path;
+  stdin : string option;
+}
+
+let command_metadata () =
+  Vec.fold_left Vec.append Vec.empty
+    (Vec.of_array
+       [|
+         Graph.metadata ();
+         List_command.metadata ();
+         Upsert.metadata ();
+         Remove.metadata ();
+         Search.metadata ();
+         Query.metadata ();
+         Show.metadata ();
+         Server_command.metadata ();
+         Sync.metadata ();
+         Completion.metadata ();
+         Skill.metadata ();
+         Example.metadata ();
+         Doctor.metadata ();
+         Debug.metadata ();
+         Agent.metadata ();
+         Auth_command.metadata ();
+       |])
+
+let command_registry () = Command_registry.make (command_metadata ())
+
+let make_app ?version:_ () =
+  { registry = command_registry (); defaults = Cli_config.defaults () }
+
+let make_app_context = make_app
+let env_lookup env key = Vec.assoc_opt key env
+let is_option token = String.length token > 0 && token.[0] = '-'
+let option_value key options =
+  Vec.find_map
+    (fun (candidate, value) -> if candidate = key then value else None)
+    options
+let option_present key options = Vec.mem_assoc key options
+
+let normalize_key = function
+  | "-g" -> Some "graph"
+  | "-o" -> Some "output"
+  | "-c" -> Some "content"
+  | "-e" -> Some "expand"
+  | "-f" -> Some "fields"
+  | "-h" -> Some "help"
+  | "-s" -> Some "sort"
+  | "-t" -> Some "type"
+  | "-v" -> Some "verbose"
+  | token when String.length token > 2 && String.sub token 0 2 = "--" ->
+      Some (String.sub token 2 (String.length token - 2))
+  | _ -> None
+
+let split_equals_option token =
+  match String.index_opt token '=' with
+  | None -> None
+  | Some index ->
+      let key = String.sub token 0 index in
+      let value =
+        String.sub token (index + 1) (String.length token - index - 1)
+      in
+      Option.map (fun key -> (key, value)) (normalize_key key)
+
+let boolean_option = function
+  | "version" | "help" | "verbose" | "profile" | "enable-sync" | "expand"
+  | "include-built-in" | "include-journal" | "journal-only" | "include-hidden"
+  | "with-properties" | "with-extends" | "with-classes" | "with-type"
+  | "page-hierarchy" | "linked-references" | "ref-id-footer" | "progress"
+  | "upload-keys" ->
+      true
+  | _ -> false
+
+let boolean_literal value =
+  match String.lowercase_ascii (String.trim value) with
+  | "true" | "false" -> true
+  | _ -> false
+
+let parse_tokens argv =
+  let rec loop options positional remaining =
+    match Vec.pop_front remaining with
+    | None -> (options, positional)
+    | Some ("--", rest) -> (options, Vec.append positional rest)
+    | Some (token, rest) -> (
+        match split_equals_option token with
+        | Some (key, value) ->
+            loop (Vec.push_back options (key, Some value)) positional rest
+        | None -> (
+            match normalize_key token with
+            | Some key when boolean_option key -> (
+                match Vec.pop_front rest with
+                | Some (value, tail) when boolean_literal value ->
+                    loop
+                      (Vec.push_back options (key, Some value))
+                      positional tail
+                | _ ->
+                    loop
+                      (Vec.push_back options (key, Some "true"))
+                      positional rest)
+            | Some key -> (
+                match Vec.pop_front rest with
+                | Some (value, tail) when not (is_option value) ->
+                    loop
+                      (Vec.push_back options (key, Some value))
+                      positional tail
+                | _ -> loop (Vec.push_back options (key, None)) positional rest)
+            | None -> loop options (Vec.push_back positional token) rest))
+  in
+  loop Vec.empty Vec.empty argv
+
+let stdin_required_for_show_id argv =
+  let options, positional = parse_tokens argv in
+  Vec.length positional = 1
+  && Vec.peek_front positional = "show"
+  && option_present "id" options
+  && Option.is_none (option_value "id" options)
+
+let read_stdin_all () = Cli_unix.read_stdin_all ()
+
+let output_mode_of_options options =
+  Option.bind (option_value "output" options) Output_mode.of_string
+  |> Option.value ~default:Output_mode.default
+
+let output_mode_of_globals globals =
+  Option.value globals.Global_opts.output_format ~default:Output_mode.default
+
+let output_mode_of_config config = Output_mode.for_config config
+
+let result_text_for_mode result (Output.Mode.Packed mode) =
+  match mode with
+  | Output.Mode.Human -> (
+      match result.Cli_result.status with
+      | Ok -> (
+          match result.data with
+          | Some (Cli_result.Message message) -> message
+          | _ -> "")
+      | Error -> (
+          match result.error with
+          | Some err -> Format_types.format_error err result.command
+          | None -> ""))
+  | Output.Mode.Json -> Format_types.to_json result
+  | Output.Mode.Edn -> Format_types.to_edn result
+
+type pending_output = {
+  stdout : string;
+  stderr : string Rrbvec.t;
+  exit_code : int;
+}
+
+let pending_output : pending_output option ref = ref None
+
+let set_pending_output ?(stderr = Vec.empty) ~exit_code stdout =
+  pending_output := Some { stdout; stderr; exit_code }
+
+let take_pending_output () =
+  let output = !pending_output in
+  pending_output := None;
+  output
+
+let set_pending_error_output ?command mode err =
+  let (Output.Mode.Packed concrete_mode) = mode in
+  let result = Cli_result.error ?command concrete_mode err in
+  set_pending_output ~exit_code:1 (result_text_for_mode result mode)
+
+let set_pending_message_output ?command mode message =
+  let (Output.Mode.Packed concrete_mode) = mode in
+  let result =
+    Cli_result.ok ?command concrete_mode (Cli_result.Message message)
+  in
+  set_pending_output ~exit_code:0 (result_text_for_mode result mode)
+
+let is_prefix prefix path =
+  let rec loop index =
+    index >= Vec.length prefix
+    || (Vec.nth prefix index = Vec.nth path index && loop (index + 1))
+  in
+  Vec.length prefix <= Vec.length path && loop 0
+
+let group_help_path registry path =
+  if Vec.is_empty path then true
+  else if Option.is_some (Command_registry.find_by_path path registry) then
+    false
+  else
+    Vec.exists
+      (fun command ->
+        is_prefix path command.Command_registry.path
+        && Vec.length command.Command_registry.path > Vec.length path)
+      registry.Command_registry.commands
+
+let help_group registry options positional =
+  if option_present "help" options then Some positional
+  else if group_help_path registry positional then Some positional
+  else None
+
+let profile_status exit_code =
+  Edn_util.keyword_t (if exit_code = 0 then "ok" else "error")
+
+let command_name = function
+  | Some command -> Command_id.to_string command
+  | None -> "unknown"
+
+let profile_lines config result exit_code =
+  match config.Cli_config.profile_session with
+  | None -> Vec.empty
+  | Some session ->
+      Profile_types.report session
+        ~command:(command_name result.Cli_result.command)
+        ~status:(profile_status exit_code)
+      |> Profile_types.render_lines
+
+let human_table_headers_order registry command =
+  match command with
+  | None -> Vec.empty
+  | Some command ->
+      registry.Command_registry.commands
+      |> Vec.find_opt (fun meta -> meta.Command_registry.id = command)
+      |> Option.map (fun (meta : Command_registry.command_meta) ->
+          meta.human_table_headers_order)
+      |> Option.value ~default:Vec.empty
+
+let with_registry_metadata app result =
+  Cli_result.with_human_table_headers_order
+    (human_table_headers_order app.registry result.Cli_result.command)
+    result
+
+let verbose_line config result =
+  if not config.Cli_config.verbose then Vec.empty
+  else
+    Vec.singleton
+      (Melange_edn_melange.to_edn_string
+         (Edn_util.map_vec
+            (Vec.of_array
+               [|
+                 (Edn_util.keyword "level", Edn_util.keyword "debug");
+                 ( Edn_util.keyword "message",
+                   Edn_util.keyword "cli/parsed-options" );
+                 ( Edn_util.keyword "command",
+                   Edn_util.string (command_name result.Cli_result.command) );
+                 (Edn_util.keyword "root-dir", Edn_util.string config.root_dir);
+               |])))
+
+type raw_argv
+type parsed_argv
+type resolved_config
+type built_action
+type executed_action
+type error
+type final
+type not_final
+
+type ('phase, 'final) state =
+  | Raw_argv_state : run_input -> (raw_argv, not_final) state
+  | Parsed_argv_state :
+      (run_input * Cli_request.t)
+      -> (parsed_argv, not_final) state
+  | Resolved_config_state :
+      (Cli_config.t * Cli_request.t)
+      -> (resolved_config, not_final) state
+  | Built_action_state :
+      (Cli_config.t * Cli_action.t)
+      -> (built_action, not_final) state
+  | Executed_action_state :
+      (Cli_config.t * Cli_result.t)
+      -> (executed_action, final) state
+  | Error_state : Error.t -> (error, final) state
+
+let make_error_state err = Error_state err
+let make_raw_argv_state _ input = Raw_argv_state input
+let parse_request _ input = Cli_parse.parse ?stdin:input.stdin input.argv
+
+let parse_args : type marker.
+    app_context ->
+    (raw_argv, marker) state ->
+    (parsed_argv, not_final) state Error.build_result =
+ fun app (Raw_argv_state input) ->
+  let input =
+    match input.stdin with
+    | Some _ -> input
+    | None when stdin_required_for_show_id input.argv ->
+        { input with stdin = Some (read_stdin_all ()) }
+    | None -> input
+  in
+  let options, positional = parse_tokens input.argv in
+  let mode = output_mode_of_options options in
+  let help =
+    if option_present "version" options then None
+    else help_group app.registry options positional
+  in
+  match help with
+  | Some group ->
+      Command_registry.render_help ~group app.registry
+      |> set_pending_message_output mode;
+      Error (Error.unknown_command "")
+  | None -> (
+      match parse_request app input with
+      | Ok request -> Ok (Parsed_argv_state (input, request))
+      | Error err ->
+          set_pending_error_output mode err;
+          Error err)
+
+let resolve_request_config app request input =
+  Cli_config.resolve ~defaults:app.defaults ~env:(env_lookup input.env)
+    request.Cli_request.globals
+  |> Cli_effect.map
+       (Error.map (fun r ->
+            { r.Cli_config.config with project_dir = Some input.cwd }))
+
+let ensure_root_config config =
+  match Root_dir_types.ensure_root_dir (Some config.Cli_config.root_dir) with
+  | Ok root_dir -> Ok { config with Cli_config.root_dir }
+  | Error _ as err -> err
+
+let graph_exists_error graph =
+  let graph_name = Cli_primitive.string_of_graph graph in
+  Error.make
+    ~context:
+      (Edn_util.map_vec
+         (Vec.of_array
+            [| (Edn_util.keyword "graph", Edn_util.string graph_name) |]))
+    Error.Graph_exists
+    ("graph already exists: " ^ graph_name)
+
+let action_graph_exists config graph =
+  Vec.exists
+    (fun existing ->
+      String.equal
+        (Cli_primitive.string_of_graph existing)
+        (Cli_primitive.string_of_graph graph))
+    (Server_runtime.list_graphs config)
+
+let ensure_action_graph_constraints config action =
+  match Cli_action.graph action with
+  | Some graph
+    when Cli_action.requires_missing_graph action
+         && action_graph_exists config graph ->
+      Error (graph_exists_error graph)
+  | _ -> Ok ()
+
+let resolve_config : type marker.
+    app_context ->
+    (parsed_argv, marker) state ->
+    (resolved_config, not_final) state Error.build_result Cli_effect.t =
+ fun app (Parsed_argv_state (input, request)) ->
+  Cli_effect.map
+    (fun result ->
+      match result with
+      | Error err ->
+          set_pending_error_output
+            ~command:(Cli_request.command_id request)
+            (output_mode_of_globals request.Cli_request.globals)
+            err;
+          Error err
+      | Ok config -> (
+          match ensure_root_config config with
+          | Error err ->
+              set_pending_error_output
+                ~command:(Cli_request.command_id request)
+                (output_mode_of_config config)
+                err;
+              Error err
+          | Ok config ->
+              let profile_session =
+                Profile_types.create_session config.Cli_config.profile
+              in
+              Option.iter
+                (fun session ->
+                  let now = Time.now () in
+                  Profile_types.record_span session
+                    {
+                      stage = "cli.parse-args";
+                      span_id = 1;
+                      start_time = now;
+                      end_time = now;
+                      elapsed_span = Time.zero_span;
+                    })
+                profile_session;
+              Ok
+                (Resolved_config_state
+                   ({ config with Cli_config.profile_session }, request))))
+    (resolve_request_config app request input)
+
+let build_request_action app request config =
+  match request.Cli_request.command with
+  | Cli_request.Completion parsed ->
+      Cli_effect.pure
+        (Error.map
+           (fun action -> Cli_action.Completion action)
+           (Completion.build ~registry:app.registry config request.globals
+              parsed))
+  | _ -> Cli_action.build config request
+
+let build_action : type marker.
+    app_context ->
+    (resolved_config, marker) state ->
+    (built_action, not_final) state Error.build_result Cli_effect.t =
+ fun app (Resolved_config_state (config, request)) ->
+  Cli_effect.map
+    (fun result ->
+      match result with
+      | Error err ->
+          set_pending_error_output
+            ~command:(Cli_request.command_id request)
+            (output_mode_of_config config)
+            err;
+          Error err
+      | Ok action -> (
+          match ensure_action_graph_constraints config action with
+          | Error err ->
+              set_pending_error_output
+                ~command:(Cli_request.command_id request)
+                (output_mode_of_config config)
+                err;
+              Error err
+          | Ok () -> Ok (Built_action_state (config, action))))
+    (build_request_action app request config)
+
+let execute_action : type marker.
+    app_context ->
+    (built_action, marker) state ->
+    (executed_action, final) state Error.build_result Cli_effect.t =
+ fun app (Built_action_state (config, action)) ->
+  Cli_effect.map
+    (fun result ->
+      Ok (Executed_action_state (config, with_registry_metadata app result)))
+    (Cli_action.execute action config)
+
+let format_cli_result result config = Format_types.format_result result config
+
+let format_result _ (Executed_action_state (config, result)) =
+  format_cli_result result config
+
+let result_exit_code result = Cli_result.exit_code result
+let write_stdout_line output = if output <> "" then print_string (output ^ "\n")
+
+let final_effect : type phase. (phase, final) state -> int Cli_effect.t =
+  function
+  | Executed_action_state (config, result) ->
+      let output = format_cli_result result config in
+      let exit_code = result_exit_code result in
+      write_stdout_line output;
+      Vec.iter prerr_endline (verbose_line config result);
+      Vec.iter prerr_endline (profile_lines config result exit_code);
+      flush stdout;
+      flush stderr;
+      Cli_effect.pure exit_code
+  | Error_state err ->
+      let output =
+        match take_pending_output () with
+        | Some output -> output
+        | None ->
+            {
+              stdout = Format_types.format_error err None;
+              stderr = Vec.empty;
+              exit_code = 1;
+            }
+      in
+      write_stdout_line output.stdout;
+      Vec.iter prerr_endline output.stderr;
+      flush stdout;
+      flush stderr;
+      Cli_effect.pure output.exit_code

cli/lib/cli_action.ml

@@ -0,0 +1,135 @@
+type t =
+  | Version
+  | Graph of Graph.action
+  | List of List_command.action
+  | Upsert of Upsert.action
+  | Remove of Remove.action
+  | Search of Search.action
+  | Query of Query.action
+  | Show of Show.action
+  | Server of Server_command.action
+  | Sync of Sync.action
+  | Auth of Auth_command.action
+  | Agent of Agent.action
+  | Doctor of Doctor.action
+  | Debug of Debug.action
+  | Skill of Skill.action
+  | Completion of Completion.action
+  | Example of Example.action
+
+let build_time : string =
+  [%mel.raw
+    {|
+typeof LOGSEQ_CLI_BUILD_TIME !== "undefined" ? LOGSEQ_CLI_BUILD_TIME : "unknown"
+|}]
+
+let revision : string =
+  [%mel.raw
+    {|
+typeof LOGSEQ_CLI_REVISION !== "undefined" ? LOGSEQ_CLI_REVISION : "dev"
+|}]
+
+let version_output () = "Build time: " ^ build_time ^ "\nRevision: " ^ revision
+
+let build config request =
+  let result =
+    match request.Cli_request.command with
+    | Cli_request.Version -> Ok Version
+    | Graph parsed ->
+        Error.bind (Graph.build config request.globals parsed) (fun action ->
+            Ok (Graph action))
+    | List parsed ->
+        Error.bind (List_command.build config request.globals parsed)
+          (fun action -> Ok (List action))
+    | Upsert parsed ->
+        Error.bind (Upsert.build config request.globals parsed) (fun action ->
+            Ok (Upsert action))
+    | Remove parsed ->
+        Error.bind (Remove.build config request.globals parsed) (fun action ->
+            Ok (Remove action))
+    | Search parsed ->
+        Error.bind (Search.build config request.globals parsed) (fun action ->
+            Ok (Search action))
+    | Query parsed ->
+        Error.bind (Query.build config request.globals parsed) (fun action ->
+            Ok (Query action))
+    | Show parsed ->
+        Error.bind (Show.build config request.globals parsed) (fun action ->
+            Ok (Show action))
+    | Server parsed ->
+        Error.bind (Server_command.build config request.globals parsed)
+          (fun action -> Ok (Server action))
+    | Sync parsed ->
+        Error.bind (Sync.build config request.globals parsed) (fun action ->
+            Ok (Sync action))
+    | Debug parsed ->
+        Error.bind (Debug.build config request.globals parsed) (fun action ->
+            Ok (Debug action))
+    | Doctor parsed ->
+        Error.bind (Doctor.build config request.globals parsed) (fun action ->
+            Ok (Doctor action))
+    | Skill parsed ->
+        Error.bind (Skill.build config request.globals parsed) (fun action ->
+            Ok (Skill action))
+    | Completion parsed ->
+        Error.bind (Completion.build config request.globals parsed)
+          (fun action -> Ok (Completion action))
+    | Example parsed ->
+        Error.bind (Example.build config request.globals parsed) (fun action ->
+            Ok (Example action))
+    | Auth parsed ->
+        Error.bind (Auth_command.build config request.globals parsed)
+          (fun action -> Ok (Auth action))
+    | Agent parsed ->
+        Error.bind (Agent.build config request.globals parsed) (fun action ->
+            Ok (Agent action))
+  in
+  Cli_effect.pure result
+
+let output_mode config =
+  Option.value config.Cli_config.output_format ~default:Output_mode.default
+
+let execute action config =
+  let (Output.Mode.Packed mode) = output_mode config in
+  match action with
+  | Version ->
+      Cli_effect.pure
+        (Cli_result.ok ~command:Command_id.Version mode
+           (Message (version_output ())))
+  | Graph action -> Graph.execute action config
+  | List action -> List_command.execute action config
+  | Upsert action -> Upsert.execute action config
+  | Remove action -> Remove.execute action config
+  | Search action -> Search.execute action config
+  | Query action -> Query.execute action config
+  | Show action -> Show.execute action config
+  | Server action -> Server_command.execute action config
+  | Sync action -> Sync.execute action config
+  | Debug action -> Debug.execute action config
+  | Doctor action -> Doctor.execute action config
+  | Skill action -> Skill.execute action config
+  | Completion action -> Completion.execute action config
+  | Example action -> Example.execute action config
+  | Auth action -> Auth_command.execute action config
+  | Agent action -> Agent.execute action config
+
+let requires_missing_graph = function
+  | Graph
+      (Graph.Graph_import { opts = { import_type = Graph.Import_sqlite; _ }; _ })
+    ->
+      true
+  | Sync (Sync.Sync_download { require_missing_graph; _ }) ->
+      require_missing_graph
+  | _ -> false
+
+let repo = function
+  | Graph a -> Graph.repo a
+  | Upsert a -> Some (Upsert.repo a)
+  | Sync (Sync.Sync_download { repo; _ }) -> Some repo
+  | _ -> None
+
+let graph = function
+  | Graph a -> Graph.graph a
+  | Upsert a -> Some (Upsert.graph a)
+  | Sync (Sync.Sync_download { graph; _ }) -> Some graph
+  | _ -> None

cli/lib/cli_config.ml

@@ -0,0 +1,495 @@
+type env = string -> string option
+
+type defaults = {
+  timeout_span : float;
+  login_timeout_span : float;
+  logout_timeout_span : float;
+  list_title_max_display_width : int;
+  root_dir : Cli_primitive.path;
+  ws_url : Cli_primitive.url;
+  http_base : Cli_primitive.url;
+}
+
+type t = {
+  graph : Cli_primitive.graph option;
+  repo : Cli_primitive.repo option;
+  root_dir : Cli_primitive.path;
+  config_path : Cli_primitive.path;
+  timeout_span : float;
+  login_timeout_span : float;
+  logout_timeout_span : float;
+  list_title_max_display_width : int;
+  output_format : Output.Mode.packed option;
+  verbose : bool;
+  profile : bool;
+  ws_url : Cli_primitive.url option;
+  http_base : Cli_primitive.url option;
+  auth_path : Cli_primitive.path option;
+  id_token : string option;
+  access_token : string option;
+  refresh_token : string option;
+  base_url : Cli_primitive.url option;
+  owner_source : Cli_primitive.owner_source;
+  project_dir : Cli_primitive.path option;
+  raw_file_config : Melange_edn_melange.any option;
+  profile_session : Profile_types.session option;
+}
+
+type source = Defaults | Env | File of Cli_primitive.path | Argv
+type resolved = { config : t; sources : source Rrbvec.t }
+
+let default_root_dir () =
+  Filename.concat (Sys.getenv_opt "HOME" |> Option.value ~default:".") "logseq"
+
+let default_config_path root_dir = Filename.concat root_dir "cli.edn"
+
+let defaults () =
+  {
+    timeout_span = Time.span_of_ms 10_000L;
+    login_timeout_span = Time.span_of_ms 300_000L;
+    logout_timeout_span = Time.span_of_ms 120_000L;
+    list_title_max_display_width = 40;
+    root_dir = default_root_dir ();
+    ws_url = "wss://api.logseq.io/sync/%s";
+    http_base = "https://api.logseq.io";
+  }
+
+let db_version_prefix = "logseq_db_"
+
+let starts_with ~prefix value =
+  let prefix_len = String.length prefix in
+  String.length value >= prefix_len && String.sub value 0 prefix_len = prefix
+
+let strip_db_version_prefix value =
+  if starts_with ~prefix:db_version_prefix value then
+    String.sub value
+      (String.length db_version_prefix)
+      (String.length value - String.length db_version_prefix)
+  else value
+
+let graph_to_repo graph =
+  let stripped =
+    let rec loop value =
+      if starts_with ~prefix:db_version_prefix value then
+        loop (strip_db_version_prefix value)
+      else value
+    in
+    loop (Cli_primitive.string_of_graph graph)
+  in
+  Cli_primitive.create_repo stripped
+
+let repo_to_graph repo =
+  Cli_primitive.create_graph
+    (strip_db_version_prefix (Cli_primitive.string_of_repo repo))
+
+let value_of_edn edn = edn
+let edn_of_value = Melange_edn_melange.to_edn_string
+let read_file = Cli_unix.read_text_file
+
+let read_config_file path =
+  if not (Cli_unix.file_exists path) then Ok None
+  else
+    let content = read_file path in
+    if String.trim content = "" then Ok None
+    else
+      try Ok (Some (Melange_edn_melange.of_edn_string content |> value_of_edn))
+      with exn ->
+        Error
+          (Error.make Error.Invalid_config
+             ("invalid config file: " ^ path ^ " (" ^ Printexc.to_string exn
+            ^ ")"))
+
+let invalid_config message = Error.make Error.Invalid_config message
+
+let parse_int_value value =
+  let value = String.trim value in
+  if value = "" then None
+  else Option.map Edn_util.int64 (Int64.of_string_opt value)
+
+let env_string key env value_key fields =
+  match env key with
+  | Some value when String.trim value <> "" ->
+      Vec.push_back fields (Edn_util.keyword value_key, Edn_util.string value)
+  | _ -> fields
+
+let env_int key env value_key fields =
+  match Option.bind (env key) parse_int_value with
+  | Some value -> Vec.push_back fields (Edn_util.keyword value_key, value)
+  | None -> fields
+
+let env_config env =
+  let fields =
+    Vec.empty
+    |> env_string "LOGSEQ_CLI_GRAPH" env "graph"
+    |> env_string "LOGSEQ_CLI_ROOT_DIR" env "root-dir"
+    |> env_string "LOGSEQ_CLI_CONFIG" env "config-path"
+    |> env_int "LOGSEQ_CLI_TIMEOUT_MS" env "timeout-ms"
+    |> env_int "LOGSEQ_CLI_LOGIN_TIMEOUT_MS" env "login-timeout-ms"
+    |> env_int "LOGSEQ_CLI_LOGOUT_TIMEOUT_MS" env "logout-timeout-ms"
+    |> env_string "LOGSEQ_CLI_OUTPUT" env "output-format"
+    |> env_string "LOGSEQ_CLI_WS_URL" env "ws-url"
+    |> env_string "LOGSEQ_CLI_HTTP_BASE" env "http-base"
+  in
+  Edn_util.map_t_vec fields
+
+let validate_env_int_value key env =
+  match env key with
+  | Some value when String.trim value <> "" -> (
+      let value = String.trim value in
+      match Int64.of_string_opt value with
+      | Some _ -> Ok ()
+      | None ->
+          Error
+            (invalid_config
+               ("invalid env " ^ key ^ ": " ^ value ^ ". Expected integer")))
+  | _ -> Ok ()
+
+let checked_env_config env =
+  Error.bind (validate_env_int_value "LOGSEQ_CLI_TIMEOUT_MS" env) (fun () ->
+      Error.bind (validate_env_int_value "LOGSEQ_CLI_LOGIN_TIMEOUT_MS" env)
+        (fun () ->
+          Error.bind (validate_env_int_value "LOGSEQ_CLI_LOGOUT_TIMEOUT_MS" env)
+            (fun () -> Ok (env_config env))))
+
+let sanitize_file_config value =
+  match Edn_util.as_map value with
+  | Some fields ->
+      Edn_util.map_vec
+        (fields
+        |> Vec.filter (fun (key, _) ->
+            match Edn_util.as_string_like key with
+            | Some ("auth-token" | "retries" | "e2ee-password") -> false
+            | _ -> true))
+  | None -> value
+
+let assoc_opt key value fields =
+  match value with
+  | None -> fields
+  | Some value ->
+      Vec.push_front
+        (Vec.remove_assoc (Edn_util.keyword key) fields)
+        (Edn_util.keyword key, Edn_util.string value)
+
+let map_fields value = Option.value (Edn_util.as_map value) ~default:Vec.empty
+
+let rec mkdir_p path =
+  if path = "" || path = Filename.dirname path || Cli_unix.file_exists path then
+    ()
+  else (
+    mkdir_p (Filename.dirname path);
+    Cli_unix.mkdir path 0o755)
+
+let write_config_file path value =
+  mkdir_p (Filename.dirname path);
+  Cli_unix.write_text_file path (edn_of_value value ^ "\n")
+
+let pick_graph config globals =
+  match globals.Global_opts.graph with Some _ as g -> g | None -> config.graph
+
+let value_string key value = Edn_util.get_string value key
+let value_int key value = Edn_util.get_int value key
+let value_int64 key value = Edn_util.get_int64 value key
+
+let normalize_output_string value =
+  let value = String.trim value in
+  if value <> "" && value.[0] = ':' then
+    String.sub value 1 (String.length value - 1)
+  else value
+
+let value_output key value =
+  Option.bind (value_string key value) (fun value ->
+      Output.Mode.of_string (normalize_output_string value))
+
+let edn_value_text value = Melange_edn_melange.to_edn_string value
+
+let validate_int64_config_value ~source key value =
+  match Edn_util.get value key with
+  | None -> Ok ()
+  | Some raw -> (
+      match Edn_util.as_int64 raw with
+      | Some _ -> Ok ()
+      | None ->
+          Error
+            (invalid_config
+               ("invalid " ^ source ^ " config " ^ key ^ ": "
+              ^ edn_value_text raw ^ ". Expected integer")))
+
+let validate_int_config_value ~source key value =
+  match Edn_util.get value key with
+  | None -> Ok ()
+  | Some raw -> (
+      match Edn_util.as_int raw with
+      | Some _ -> Ok ()
+      | None ->
+          Error
+            (invalid_config
+               ("invalid " ^ source ^ " config " ^ key ^ ": "
+              ^ edn_value_text raw ^ ". Expected integer")))
+
+let validate_output_config_value ~source key value =
+  match Edn_util.get value key with
+  | None -> Ok ()
+  | Some raw -> (
+      match Edn_util.as_string_like raw with
+      | Some output
+        when Option.is_some
+               (Output.Mode.of_string (normalize_output_string output)) ->
+          Ok ()
+      | _ ->
+          Error
+            (invalid_config
+               ("invalid " ^ source ^ " config " ^ key ^ ": "
+              ^ edn_value_text raw ^ ". Expected one of human, json, edn")))
+
+let validate_config_values ~source value =
+  Error.bind (validate_int64_config_value ~source "timeout-ms" value) (fun () ->
+      Error.bind (validate_int64_config_value ~source "login-timeout-ms" value)
+        (fun () ->
+          Error.bind
+            (validate_int64_config_value ~source "logout-timeout-ms" value)
+            (fun () ->
+              Error.bind
+                (validate_int_config_value ~source
+                   "list-title-max-display-width" value) (fun () ->
+                  Error.bind
+                    (validate_output_config_value ~source "output-format" value)
+                    (fun () ->
+                      validate_output_config_value ~source "output" value)))))
+
+let first_some values = Vec.find_map (fun value -> value) values
+
+let positive_or_default value default =
+  match value with Some value when value > 0 -> value | _ -> default
+
+let span_option_of_ms value = Option.map Time.span_of_ms value
+
+let resolve ~(defaults : defaults) ~env (globals : Global_opts.t) =
+  match checked_env_config env with
+  | Error _ as err -> Cli_effect.pure err
+  | Ok env_config -> (
+      let env_config = Edn_util.any env_config in
+      let initial_root_dir =
+        first_some
+          (Vec.of_array
+             [|
+               globals.root_dir;
+               value_string "root-dir" env_config;
+               Some defaults.root_dir;
+             |])
+        |> Option.value ~default:defaults.root_dir
+      in
+      let config_path =
+        first_some
+          (Vec.of_array
+             [|
+               globals.config_path;
+               value_string "config-path" env_config;
+               Some (default_config_path initial_root_dir);
+             |])
+        |> Option.value ~default:(default_config_path initial_root_dir)
+      in
+      match read_config_file config_path with
+      | Error _ as err -> Cli_effect.pure err
+      | Ok raw_file_config -> (
+          let raw_file_config =
+            Option.map sanitize_file_config raw_file_config
+          in
+          match
+            Error.bind (validate_config_values ~source:"env" env_config)
+              (fun () ->
+                match raw_file_config with
+                | None -> Ok ()
+                | Some file_config ->
+                    validate_config_values ~source:"file" file_config)
+          with
+          | Error _ as err -> Cli_effect.pure err
+          | Ok () ->
+              let base_url = env "LOGSEQ_CLI_BASE_URL" in
+              let file_graph =
+                Option.bind raw_file_config (value_string "graph")
+                |> Option.map Cli_primitive.create_graph
+              in
+              let env_graph =
+                value_string "graph" env_config
+                |> Option.map Cli_primitive.create_graph
+              in
+              let root_dir =
+                first_some
+                  (Vec.of_array
+                     [|
+                       globals.root_dir;
+                       value_string "root-dir" env_config;
+                       Option.bind raw_file_config (value_string "root-dir");
+                       Some initial_root_dir;
+                     |])
+                |> Option.value ~default:initial_root_dir
+              in
+              let graph =
+                first_some
+                  (Vec.of_array [| globals.graph; env_graph; file_graph |])
+              in
+              let repo = Option.map graph_to_repo graph in
+              let file_ws_url =
+                Option.bind raw_file_config (fun value ->
+                    Edn_util.get_string value "ws-url")
+              in
+              let file_http_base =
+                Option.bind raw_file_config (fun value ->
+                    Edn_util.get_string value "http-base")
+              in
+              let file_auth_path =
+                Option.bind raw_file_config (fun value ->
+                    Edn_util.get_string value "auth-path")
+              in
+              let file_id_token =
+                Option.bind raw_file_config (fun value ->
+                    Edn_util.get_string value "id-token")
+              in
+              let file_access_token =
+                Option.bind raw_file_config (fun value ->
+                    Edn_util.get_string value "access-token")
+              in
+              let file_refresh_token =
+                Option.bind raw_file_config (fun value ->
+                    Edn_util.get_string value "refresh-token")
+              in
+              let env_ws_url = Edn_util.get_string env_config "ws-url" in
+              let env_http_base = Edn_util.get_string env_config "http-base" in
+              let output_format =
+                first_some
+                  (Vec.of_array
+                     [|
+                       globals.output_format;
+                       value_output "output-format" env_config;
+                       Option.bind raw_file_config
+                         (value_output "output-format");
+                       Option.bind raw_file_config (value_output "output");
+                     |])
+              in
+              let timeout_span =
+                first_some
+                  (Vec.of_array
+                     [|
+                       globals.timeout_span;
+                       span_option_of_ms (value_int64 "timeout-ms" env_config);
+                       span_option_of_ms
+                         (Option.bind raw_file_config (value_int64 "timeout-ms"));
+                       Some defaults.timeout_span;
+                     |])
+                |> Option.value ~default:defaults.timeout_span
+              in
+              let login_timeout_span =
+                first_some
+                  (Vec.of_array
+                     [|
+                       span_option_of_ms
+                         (value_int64 "login-timeout-ms" env_config);
+                       span_option_of_ms
+                         (Option.bind raw_file_config
+                            (value_int64 "login-timeout-ms"));
+                       Some defaults.login_timeout_span;
+                     |])
+                |> Option.value ~default:defaults.login_timeout_span
+              in
+              let logout_timeout_span =
+                first_some
+                  (Vec.of_array
+                     [|
+                       span_option_of_ms
+                         (value_int64 "logout-timeout-ms" env_config);
+                       span_option_of_ms
+                         (Option.bind raw_file_config
+                            (value_int64 "logout-timeout-ms"));
+                       Some defaults.logout_timeout_span;
+                     |])
+                |> Option.value ~default:defaults.logout_timeout_span
+              in
+              let list_title_max_display_width =
+                positive_or_default
+                  (Option.bind raw_file_config
+                     (value_int "list-title-max-display-width"))
+                  defaults.list_title_max_display_width
+              in
+              let config =
+                {
+                  graph;
+                  repo;
+                  root_dir;
+                  config_path;
+                  timeout_span;
+                  login_timeout_span;
+                  logout_timeout_span;
+                  list_title_max_display_width;
+                  output_format;
+                  verbose = globals.verbose;
+                  profile = globals.profile;
+                  ws_url =
+                    Some
+                      (Option.value env_ws_url
+                         ~default:
+                           (Option.value file_ws_url ~default:defaults.ws_url));
+                  http_base =
+                    Some
+                      (Option.value env_http_base
+                         ~default:
+                           (Option.value file_http_base
+                              ~default:defaults.http_base));
+                  auth_path = file_auth_path;
+                  id_token = file_id_token;
+                  access_token = file_access_token;
+                  refresh_token = file_refresh_token;
+                  base_url;
+                  owner_source = Cli_primitive.Cli;
+                  project_dir = None;
+                  raw_file_config;
+                  profile_session = None;
+                }
+              in
+              Cli_effect.pure
+                (Ok
+                   {
+                     config;
+                     sources =
+                       Vec.of_array [| Defaults; File config_path; Env; Argv |];
+                   })))
+
+let update_config config patch =
+  let original =
+    match config.raw_file_config with
+    | Some value -> value
+    | None -> Edn_util.map_vec Vec.empty
+  in
+  let fields = map_fields original in
+  let fields =
+    fields
+    |> assoc_opt "ws-url" (Edn_util.get_string patch "ws-url")
+    |> assoc_opt "http-base" (Edn_util.get_string patch "http-base")
+    |> assoc_opt "graph" (Edn_util.get_string patch "graph")
+  in
+  let fields =
+    match Edn_util.get patch "ws-url" with
+    | Some value when Edn_util.is_null value ->
+        Vec.remove_assoc (Edn_util.keyword "ws-url") fields
+    | _ -> fields
+  in
+  let fields =
+    match Edn_util.get patch "http-base" with
+    | Some value when Edn_util.is_null value ->
+        Vec.remove_assoc (Edn_util.keyword "http-base") fields
+    | _ -> fields
+  in
+  let fields =
+    match Edn_util.get patch "graph" with
+    | Some value when Edn_util.is_null value ->
+        Vec.remove_assoc (Edn_util.keyword "graph") fields
+    | _ -> fields
+  in
+  let value = Edn_util.map_t_vec (fields |> Vec.rev) in
+  try
+    write_config_file config.config_path (Edn_util.any value);
+    Cli_effect.pure (Ok value)
+  with exn ->
+    Cli_effect.pure
+      (Error
+         (Error.make Error.Config_write_failed
+            ("failed to write config file: " ^ Printexc.to_string exn)))

cli/lib/cli_primitive.ml

@@ -0,0 +1,98 @@
+type keyword = Melange_edn_melange.keyword Melange_edn_melange.t
+type graph = string
+type repo = string
+type db_id = int64
+type uuid = string
+type path = string
+type url = string
+type email = string
+type shell = Bash | Zsh
+type port = int
+type pid = int
+type owner_source = Cli | Electron | Unknown | Other of string
+
+type ds_where_clause =
+  | V of Melange_edn_melange.vector Melange_edn_melange.t
+  | L of Melange_edn_melange.list_ Melange_edn_melange.t
+
+type datascript_query = {
+  find : Melange_edn_melange.any Rrbvec.t;
+  in_ : Melange_edn_melange.symbol Melange_edn_melange.t Rrbvec.t option;
+  where : ds_where_clause Rrbvec.t;
+}
+
+let trim = String.trim
+let db_version_prefix = "logseq_db_"
+
+let starts_with ~prefix value =
+  let prefix_len = String.length prefix in
+  String.length value >= prefix_len && String.sub value 0 prefix_len = prefix
+
+let create_graph value = String.trim value
+
+let create_repo value =
+  let value = String.trim value in
+  if starts_with ~prefix:db_version_prefix value then value
+  else db_version_prefix ^ value
+
+let string_of_graph graph = graph
+let string_of_repo repo = repo
+
+let non_empty s =
+  let s = trim s in
+  if s = "" then None else Some s
+
+let is_uuid_hex = function
+  | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
+  | _ -> false
+
+let is_uuid_string s =
+  let s = String.trim s in
+  let valid_char idx ch =
+    match idx with 8 | 13 | 18 | 23 -> ch = '-' | _ -> is_uuid_hex ch
+  in
+  let rec loop idx =
+    idx = String.length s || (valid_char idx s.[idx] && loop (idx + 1))
+  in
+  String.length s = 36 && loop 0
+
+let shell_of_string = function
+  | "bash" -> Some Bash
+  | "zsh" -> Some Zsh
+  | _ -> None
+
+let string_of_owner_source = function
+  | Cli -> "cli"
+  | Electron -> "electron"
+  | Unknown -> "unknown"
+  | Other s -> s
+
+let make_datascript_query ~find ?in_ ~where () =
+  let in_ =
+    match in_ with
+    | None -> None
+    | Some values when Vec.is_empty values -> None
+    | Some values -> Some values
+  in
+  { find; in_; where }
+
+let datascript_query_to_edn query =
+  let input_clause =
+    match query.in_ with
+    | None -> Vec.empty
+    | Some inputs ->
+        Vec.push_front
+          (inputs |> Vec.map (fun value -> Edn_util.any value))
+          (Edn_util.keyword "in")
+  in
+  let where_clause = function
+    | V value -> Edn_util.any value
+    | L value -> Edn_util.any value
+  in
+  Edn_util.vector_t_vec
+    (Vec.append
+       (Vec.push_front query.find (Edn_util.keyword "find"))
+       (Vec.append input_clause
+          (Vec.push_front
+             (query.where |> Vec.map where_clause)
+             (Edn_util.keyword "where"))))

cli/lib/cli_request.ml

@@ -0,0 +1,48 @@
+type parsed_command =
+  | Version
+  | Graph of Graph.parsed
+  | List of List_command.parsed
+  | Upsert of Upsert.parsed
+  | Remove of Remove.parsed
+  | Search of Search.parsed
+  | Query of Query.parsed
+  | Show of Show.parsed
+  | Server of Server_command.parsed
+  | Sync of Sync.parsed
+  | Auth of Auth_command.parsed
+  | Agent of Agent.parsed
+  | Doctor of Doctor.parsed
+  | Debug of Debug.parsed
+  | Skill of Skill.parsed
+  | Completion of Completion.parsed
+  | Example of Example.parsed
+
+type t = {
+  globals : Global_opts.t;
+  path : string Rrbvec.t;
+  command : parsed_command;
+  raw_args : string Rrbvec.t;
+}
+
+let make ~globals ~path ~command ~raw_args =
+  { globals; path; command; raw_args }
+
+let command_id t =
+  match t.command with
+  | Version -> Command_id.Version
+  | Graph p -> Graph.command_id p
+  | List p -> List_command.command_id p
+  | Upsert p -> Upsert.command_id p
+  | Remove p -> Remove.command_id p
+  | Search p -> Search.command_id p
+  | Query p -> Query.command_id p
+  | Show p -> Show.command_id p
+  | Server p -> Server_command.command_id p
+  | Sync p -> Sync.command_id p
+  | Auth p -> Auth_command.command_id p
+  | Agent p -> Agent.command_id p
+  | Doctor p -> Doctor.command_id p
+  | Debug p -> Debug.command_id p
+  | Skill p -> Skill.command_id p
+  | Completion p -> Completion.command_id p
+  | Example p -> Example.command_id p

cli/lib/cli_result.ml

@@ -0,0 +1,426 @@
+type status = Ok | Error
+
+type ok_data =
+  | Message of string
+  | Items of Melange_edn_melange.any Rrbvec.t
+  | Entity of Melange_edn_melange.any
+  | Query_result of Melange_edn_melange.any
+  | Raw of Melange_edn_melange.any
+  | Empty
+
+type error_data = Error.t
+
+type t = {
+  status : status;
+  data : ok_data option;
+  error : error_data option;
+  command : Command_id.t option;
+  context : Melange_edn_melange.any option;
+  output : 'o. 'o Output.Mode.t -> 'o Output.t;
+  exit_code : int option;
+  human_table_headers_order : string Rrbvec.t;
+}
+
+let data_value = function
+  | Message s -> Edn_util.string s
+  | Items xs -> Edn_util.vector_vec xs
+  | Entity v | Query_result v | Raw v -> v
+  | Empty -> Edn_util.nil
+
+let human_table ?headers ?footer rows : Output.Human_output.t =
+  Output.Human_output.create ?headers ?footer ~rows ()
+
+let human_message message = human_table (Vec.singleton (Vec.singleton message))
+let empty_human = human_table Vec.empty
+let count_footer count = "Count: " ^ Humanize_types.format_count count
+
+let strip_leading_colon value =
+  if String.length value > 0 && value.[0] = ':' then
+    String.sub value 1 (String.length value - 1)
+  else value
+
+let field_label key =
+  key |> Edn_util.as_string_like
+  |> Option.value ~default:(Melange_edn_melange.to_edn_string key)
+  |> strip_leading_colon
+
+let value_text value =
+  match
+    ( Edn_util.is_null value,
+      Edn_util.as_string_like value,
+      Edn_util.as_int value,
+      Edn_util.as_bool value,
+      Edn_util.as_float value )
+  with
+  | true, _, _, _, _ -> ""
+  | _, Some value, _, _, _ -> strip_leading_colon value
+  | _, _, Some value, _, _ -> string_of_int value
+  | _, _, _, Some value, _ -> string_of_bool value
+  | _, _, _, _, Some value -> string_of_float value
+  | _ -> Melange_edn_melange.to_edn_string value
+
+let has_suffix ~suffix value =
+  let suffix_len = String.length suffix in
+  let value_len = String.length value in
+  value_len >= suffix_len
+  && String.sub value (value_len - suffix_len) suffix_len = suffix
+
+let normalized_label label = String.lowercase_ascii label
+
+let is_created_at_field label =
+  has_suffix ~suffix:"created-at" (normalized_label label)
+
+let is_updated_at_field label =
+  has_suffix ~suffix:"updated-at" (normalized_label label)
+
+let is_datetime_field label =
+  is_created_at_field label || is_updated_at_field label
+
+let field_value_text label value =
+  let text = value_text value in
+  match Int64.of_string_opt text with
+  | Some epoch_ms when is_datetime_field label ->
+      Humanize_types.relative_datetime
+        ~then_time:(Time.time_of_epoch_ms epoch_ms)
+        ~now_time:(Time.now ())
+  | _ -> text
+
+let parse_positive_int64 text =
+  let text = String.trim text in
+  if text = "" then None else Int64.of_string_opt text
+
+let graph_info_timestamp_seconds value =
+  let timestamp =
+    match Edn_util.as_int64 value with
+    | Some value -> Some value
+    | None -> parse_positive_int64 (value_text value)
+  in
+  timestamp
+  |> Option.map (fun timestamp ->
+      if Int64.compare timestamp 100_000_000_000L >= 0 then
+        Int64.div timestamp 1_000L
+      else timestamp)
+
+let graph_info_field_value_text label value =
+  match graph_info_timestamp_seconds value with
+  | Some then_seconds when is_datetime_field label ->
+      Humanize_types.datetime
+        ~now:(Time.time_to_epoch_seconds (Time.now ()))
+        then_seconds
+  | _ -> value_text value
+
+let add_column acc label =
+  if Vec.mem label acc then acc else Vec.push_back acc label
+
+let table_columns items =
+  items
+  |> Vec.fold_left
+       (fun acc fields ->
+         fields
+         |> Vec.map (fun (key, _) -> field_label key)
+         |> Vec.fold_left add_column acc)
+       Vec.empty
+
+let field_by_label label fields =
+  fields
+  |> Vec.find_map (fun (key, value) ->
+      if field_label key = label then Some value else None)
+
+let mapped_items_human items =
+  let mapped = Vec.filter_map Edn_util.as_map items in
+  if Vec.length mapped = Vec.length items then
+    let headers = table_columns mapped in
+    let rows =
+      mapped
+      |> Vec.map (fun fields ->
+          headers
+          |> Vec.map (fun label ->
+              fields |> field_by_label label |> Option.map value_text
+              |> Option.value ~default:""))
+    in
+    human_table ~headers ~footer:(count_footer (Vec.length rows)) rows
+  else
+    let seqs = Vec.filter_map Edn_util.as_seq items in
+    if Vec.length seqs = Vec.length items then
+      let width =
+        seqs |> Vec.fold_left (fun acc row -> max acc (Vec.length row)) 0
+      in
+      let headers =
+        Vec.init width (fun index -> "Column " ^ string_of_int (index + 1))
+      in
+      let rows =
+        seqs
+        |> Vec.map (fun row ->
+            Vec.init width (fun index ->
+                Vec.nth_opt row index |> Option.map value_text
+                |> Option.value ~default:""))
+      in
+      human_table ~headers ~footer:(count_footer (Vec.length rows)) rows
+    else
+      human_table ~headers:(Vec.singleton "Value")
+        ~footer:(count_footer (Vec.length items))
+        (Vec.map (fun value -> Vec.singleton (value_text value)) items)
+
+let items_human value =
+  Option.bind (Edn_util.get value "items") Edn_util.as_seq
+  |> Option.map mapped_items_human
+
+let list_like_fields =
+  Vec.of_array
+    [| "items"; "queries"; "checks"; "servers"; "backups"; "graphs"; "routed" |]
+
+let sequence_field_by_label label fields =
+  fields
+  |> Vec.find_map (fun (key, value) ->
+      if field_label key = label then
+        value |> Edn_util.as_seq |> Option.map mapped_items_human
+      else None)
+
+let list_like_sequence_field fields =
+  list_like_fields
+  |> Vec.find_map (fun label -> sequence_field_by_label label fields)
+
+let single_result_sequence_field fields =
+  match Vec.nth_opt fields 0 with
+  | Some (key, value) when Vec.length fields = 1 && field_label key = "result"
+    ->
+      value |> Edn_util.as_seq |> Option.map mapped_items_human
+  | _ -> None
+
+let sequence_field_human fields =
+  match list_like_sequence_field fields with
+  | Some table -> Some table
+  | None -> single_result_sequence_field fields
+
+let field_rows fields =
+  Vec.map
+    (fun (key, value) ->
+      let label = field_label key in
+      Vec.of_array [| label; field_value_text label value |])
+    fields
+
+let map_human fields = human_table (field_rows fields)
+
+let value_human value =
+  match Edn_util.as_map value with
+  | Some fields -> (
+      match sequence_field_human fields with
+      | Some table -> table
+      | None -> map_human fields)
+  | None -> (
+      match Edn_util.as_seq value with
+      | Some values -> mapped_items_human values
+      | None -> human_message (value_text value))
+
+let graph_list_human value =
+  match Edn_util.as_map value with
+  | Some fields -> (
+      let current_graph =
+        match Vec.assoc_opt (Edn_util.keyword "current-graph") fields with
+        | Some value -> Edn_util.as_string value
+        | None -> None
+      in
+      match Vec.assoc_opt (Edn_util.keyword "graphs") fields with
+      | Some graphs_value -> (
+          match Edn_util.as_vector graphs_value with
+          | Some graphs ->
+              let rows =
+                Vec.map
+                  (fun graph ->
+                    let graph =
+                      Option.value (Edn_util.as_string graph)
+                        ~default:(Melange_edn_melange.to_edn_string graph)
+                    in
+                    let prefix =
+                      if Option.equal String.equal current_graph (Some graph)
+                      then "* "
+                      else if Option.is_some current_graph then "  "
+                      else ""
+                    in
+                    Vec.singleton (prefix ^ graph))
+                  graphs
+              in
+              human_table ~footer:(count_footer (Vec.length rows)) rows
+          | None -> empty_human)
+      | None -> empty_human)
+  | None -> empty_human
+
+let text_list value key =
+  Option.bind (Edn_util.get value key) Edn_util.as_seq
+  |> Option.map (Vec.map value_text)
+  |> Option.value ~default:Vec.empty
+
+let bullet_lines values =
+  if Vec.is_empty values then Vec.singleton "  - (none)"
+  else Vec.map (fun value -> "  - " ^ value) values
+
+let example_human value =
+  let selector =
+    Edn_util.get_string value "selector" |> Option.value ~default:"-"
+  in
+  let matched_commands = text_list value "matched-commands" in
+  let examples = text_list value "examples" in
+  let message = Edn_util.get_string value "message" in
+  let lines =
+    Vec.append
+      (match message with
+      | Some message -> Vec.singleton message
+      | None -> Vec.empty)
+      (Vec.of_array [| "Selector: " ^ selector; "Matched commands:" |])
+    |> fun lines ->
+    Vec.append lines (bullet_lines matched_commands) |> fun lines ->
+    Vec.push_back lines "Examples:" |> fun lines ->
+    Vec.append lines (bullet_lines examples)
+  in
+  human_table (Vec.map (fun line -> Vec.singleton line) lines)
+
+let contains_substring ~needle text =
+  let needle_len = String.length needle in
+  let text_len = String.length text in
+  let rec loop index =
+    index + needle_len <= text_len
+    && (String.sub text index needle_len = needle || loop (index + 1))
+  in
+  loop 0
+
+let sensitive_field label =
+  let label = String.lowercase_ascii label in
+  Vec.exists
+    (fun needle -> contains_substring ~needle label)
+    (Vec.of_array [| "token"; "secret"; "password" |])
+
+let graph_info_human value =
+  match Edn_util.as_map value with
+  | Some fields ->
+      let graph_rows =
+        match Vec.assoc_opt (Edn_util.keyword "graph") fields with
+        | Some graph ->
+            Vec.singleton (Vec.of_array [| "graph"; value_text graph |])
+        | None -> Vec.empty
+      in
+      let kv_rows =
+        match Vec.assoc_opt (Edn_util.keyword "kv") fields with
+        | Some kv -> (
+            match Edn_util.as_map kv with
+            | Some kv_fields ->
+                Vec.map
+                  (fun (key, value) ->
+                    let label = field_label key in
+                    Vec.of_array
+                      [|
+                        label;
+                        (if sensitive_field label then "[REDACTED]"
+                         else graph_info_field_value_text label value);
+                      |])
+                  kv_fields
+            | None -> Vec.empty)
+        | None -> Vec.empty
+      in
+      human_table (Vec.append graph_rows kv_rows)
+  | None -> empty_human
+
+let remote_graph_columns =
+  Vec.of_array
+    [| "graph-name"; "graph-id"; "graph-e2ee?"; "role"; "created-at" |]
+
+let remote_graph_row graph =
+  match Edn_util.as_map graph with
+  | Some fields ->
+      remote_graph_columns
+      |> Vec.map (fun label ->
+          fields |> field_by_label label |> Option.map value_text
+          |> Option.value ~default:"")
+  | None -> Vec.of_array [| value_text graph; ""; ""; ""; "" |]
+
+let remote_graphs_human value =
+  match Edn_util.as_map value with
+  | Some fields -> (
+      match Vec.assoc_opt (Edn_util.keyword "graphs") fields with
+      | Some graphs_value -> (
+          match Edn_util.as_seq graphs_value with
+          | Some graphs ->
+              let rows = Vec.map remote_graph_row graphs in
+              human_table ~headers:remote_graph_columns
+                ~footer:(count_footer (Vec.length rows))
+                rows
+          | None -> empty_human)
+      | None -> empty_human)
+  | None -> empty_human
+
+let human_output command data =
+  match data with
+  | Message s -> human_message s
+  | Empty -> empty_human
+  | Raw value when command = Some Command_id.Graph_list ->
+      graph_list_human value
+  | Raw value when command = Some Command_id.Graph_info ->
+      graph_info_human value
+  | Raw value when command = Some Command_id.Example -> example_human value
+  | Raw value when command = Some Command_id.Sync_remote_graphs ->
+      remote_graphs_human value
+  | Raw value -> (
+      match items_human value with
+      | Some table -> table
+      | None -> value_human value)
+  | Entity value | Query_result value -> value_human value
+  | Items values ->
+      human_table ~headers:(Vec.singleton "Value")
+        ~footer:(count_footer (Vec.length values))
+        (Vec.map
+           (fun value ->
+             Vec.singleton (Melange_edn_melange.to_edn_string value))
+           values)
+
+let output_for_data : type a.
+    Command_id.t option -> a Output.Mode.t -> ok_data -> a Output.t =
+ fun command mode data ->
+  match mode with
+  | Output.Mode.Human -> Output.Human (human_output command data)
+  | Output.Mode.Json -> Output.Json (data_value data)
+  | Output.Mode.Edn -> Output.Edn (data_value data)
+
+let ok ?command ?context mode data =
+  let (_ : _ Output.Mode.t) = mode in
+  {
+    status = Ok;
+    data = Some data;
+    error = None;
+    command;
+    context;
+    output = (fun mode -> output_for_data command mode data);
+    exit_code = None;
+    human_table_headers_order = Vec.empty;
+  }
+
+let error ?command ?context mode error =
+  let (_ : _ Output.Mode.t) = mode in
+  let output : type a. a Output.Mode.t -> a Output.t = function
+    | Output.Mode.Human -> Output.Human (human_message error.Error.message)
+    | Output.Mode.Json -> Output.Json Edn_util.nil
+    | Output.Mode.Edn -> Output.Edn Edn_util.nil
+  in
+  {
+    status = Error;
+    data = None;
+    error = Some error;
+    command;
+    context;
+    output;
+    exit_code = Some 1;
+    human_table_headers_order = Vec.empty;
+  }
+
+let is_error t = t.status = Error
+
+let exit_code t =
+  match t.exit_code with Some c -> c | None -> if is_error t then 1 else 0
+
+let data_value t =
+  match t.data with
+  | Some Empty | None -> None
+  | Some data -> Some (data_value data)
+
+let with_command command t = { t with command = Some command }
+
+let with_human_table_headers_order human_table_headers_order t =
+  { t with human_table_headers_order }

cli/lib/command_id.ml

@@ -0,0 +1,177 @@
+type t =
+  | Version
+  | Graph_list
+  | Graph_create
+  | Graph_switch
+  | Graph_remove
+  | Graph_validate
+  | Graph_info
+  | Graph_backup_list
+  | Graph_backup_create
+  | Graph_backup_restore
+  | Graph_backup_remove
+  | Graph_export
+  | Graph_import
+  | Server_list
+  | Server_cleanup
+  | Server_start
+  | Server_stop
+  | Server_restart
+  | List_page
+  | List_tag
+  | List_property
+  | List_task
+  | List_node
+  | List_asset
+  | Search_block
+  | Search_page
+  | Search_property
+  | Search_tag
+  | Upsert_block
+  | Upsert_page
+  | Upsert_task
+  | Upsert_asset
+  | Upsert_tag
+  | Upsert_property
+  | Remove_block
+  | Remove_page
+  | Remove_tag
+  | Remove_property
+  | Query
+  | Query_list
+  | Show
+  | Debug_pull
+  | Doctor
+  | Sync_status
+  | Sync_start
+  | Sync_stop
+  | Sync_upload
+  | Sync_download
+  | Sync_asset_download
+  | Sync_remote_graphs
+  | Sync_ensure_keys
+  | Sync_grant_access
+  | Sync_config_get
+  | Sync_config_set
+  | Sync_config_unset
+  | Login
+  | Logout
+  | Completion
+  | Skill_show
+  | Skill_install
+  | Example
+  | Agent_bridge
+
+let path segments = Vec.of_array segments
+
+let table =
+  Vec.of_array
+    [|
+      (Version, "version", Vec.empty);
+      (Graph_list, "graph-list", path [| "graph"; "list" |]);
+      (Graph_create, "graph-create", path [| "graph"; "create" |]);
+      (Graph_switch, "graph-switch", path [| "graph"; "switch" |]);
+      (Graph_remove, "graph-remove", path [| "graph"; "remove" |]);
+      (Graph_validate, "graph-validate", path [| "graph"; "validate" |]);
+      (Graph_info, "graph-info", path [| "graph"; "info" |]);
+      ( Graph_backup_list,
+        "graph-backup-list",
+        path [| "graph"; "backup"; "list" |] );
+      ( Graph_backup_create,
+        "graph-backup-create",
+        path [| "graph"; "backup"; "create" |] );
+      ( Graph_backup_restore,
+        "graph-backup-restore",
+        path [| "graph"; "backup"; "restore" |] );
+      ( Graph_backup_remove,
+        "graph-backup-remove",
+        path [| "graph"; "backup"; "remove" |] );
+      (Graph_export, "graph-export", path [| "graph"; "export" |]);
+      (Graph_import, "graph-import", path [| "graph"; "import" |]);
+      (Server_list, "server-list", path [| "server"; "list" |]);
+      (Server_cleanup, "server-cleanup", path [| "server"; "cleanup" |]);
+      (Server_start, "server-start", path [| "server"; "start" |]);
+      (Server_stop, "server-stop", path [| "server"; "stop" |]);
+      (Server_restart, "server-restart", path [| "server"; "restart" |]);
+      (List_page, "list-page", path [| "list"; "page" |]);
+      (List_tag, "list-tag", path [| "list"; "tag" |]);
+      (List_property, "list-property", path [| "list"; "property" |]);
+      (List_task, "list-task", path [| "list"; "task" |]);
+      (List_node, "list-node", path [| "list"; "node" |]);
+      (List_asset, "list-asset", path [| "list"; "asset" |]);
+      (Search_block, "search-block", path [| "search"; "block" |]);
+      (Search_page, "search-page", path [| "search"; "page" |]);
+      (Search_property, "search-property", path [| "search"; "property" |]);
+      (Search_tag, "search-tag", path [| "search"; "tag" |]);
+      (Upsert_block, "upsert-block", path [| "upsert"; "block" |]);
+      (Upsert_page, "upsert-page", path [| "upsert"; "page" |]);
+      (Upsert_task, "upsert-task", path [| "upsert"; "task" |]);
+      (Upsert_asset, "upsert-asset", path [| "upsert"; "asset" |]);
+      (Upsert_tag, "upsert-tag", path [| "upsert"; "tag" |]);
+      (Upsert_property, "upsert-property", path [| "upsert"; "property" |]);
+      (Remove_block, "remove-block", path [| "remove"; "block" |]);
+      (Remove_page, "remove-page", path [| "remove"; "page" |]);
+      (Remove_tag, "remove-tag", path [| "remove"; "tag" |]);
+      (Remove_property, "remove-property", path [| "remove"; "property" |]);
+      (Query, "query", path [| "query" |]);
+      (Query_list, "query-list", path [| "query"; "list" |]);
+      (Show, "show", path [| "show" |]);
+      (Debug_pull, "debug-pull", path [| "debug"; "pull" |]);
+      (Doctor, "doctor", path [| "doctor" |]);
+      (Sync_status, "sync-status", path [| "sync"; "status" |]);
+      (Sync_start, "sync-start", path [| "sync"; "start" |]);
+      (Sync_stop, "sync-stop", path [| "sync"; "stop" |]);
+      (Sync_upload, "sync-upload", path [| "sync"; "upload" |]);
+      (Sync_download, "sync-download", path [| "sync"; "download" |]);
+      ( Sync_asset_download,
+        "sync-asset-download",
+        path [| "sync"; "asset"; "download" |] );
+      ( Sync_remote_graphs,
+        "sync-remote-graphs",
+        path [| "sync"; "remote-graphs" |] );
+      (Sync_ensure_keys, "sync-ensure-keys", path [| "sync"; "ensure-keys" |]);
+      (Sync_grant_access, "sync-grant-access", path [| "sync"; "grant-access" |]);
+      (Sync_config_get, "sync-config-get", path [| "sync"; "config"; "get" |]);
+      (Sync_config_set, "sync-config-set", path [| "sync"; "config"; "set" |]);
+      ( Sync_config_unset,
+        "sync-config-unset",
+        path [| "sync"; "config"; "unset" |] );
+      (Login, "login", path [| "login" |]);
+      (Logout, "logout", path [| "logout" |]);
+      (Completion, "completion", path [| "completion" |]);
+      (Skill_show, "skill-show", path [| "skill"; "show" |]);
+      (Skill_install, "skill-install", path [| "skill"; "install" |]);
+      (Example, "example", path [| "example" |]);
+      (Agent_bridge, "agent-bridge", path [| "agent"; "bridge" |]);
+    |]
+
+let to_string t =
+  let _, s, _ = Vec.find (fun (id, _, _) -> id = t) table in
+  s
+
+let to_path t =
+  let _, _, p = Vec.find (fun (id, _, _) -> id = t) table in
+  p
+
+let is_write = function
+  | Graph_create | Graph_switch | Graph_remove | Graph_import | Upsert_block
+  | Upsert_page | Upsert_task | Upsert_asset | Upsert_tag | Upsert_property
+  | Remove_block | Remove_page | Remove_tag | Remove_property | Sync_start
+  | Sync_stop | Sync_upload | Sync_download | Sync_asset_download
+  | Sync_ensure_keys | Sync_grant_access | Sync_config_set | Sync_config_unset
+  | Login | Logout | Skill_install ->
+      true
+  | _ -> false
+
+let requires_graph = function
+  | Version | Graph_list | Server_list | Server_cleanup | Completion | Login
+  | Logout | Skill_show | Skill_install | Example | Sync_remote_graphs ->
+      false
+  | _ -> true
+
+let requires_auth = function
+  | Sync_status | Sync_start | Sync_stop | Sync_upload | Sync_download
+  | Sync_asset_download | Sync_remote_graphs | Sync_ensure_keys
+  | Sync_grant_access | Sync_config_get | Sync_config_set | Sync_config_unset ->
+      true
+  | _ -> false

cli/lib/command_registry.ml

@@ -0,0 +1,613 @@
+type category =
+  | Graph_inspect_and_edit
+  | Graph_management
+  | Authentication
+  | Utilities
+  | Hidden
+
+type option_arity = Flag | Required_value of string | Optional_value of string
+
+type option_meta = {
+  names : string Rrbvec.t;
+  arity : option_arity;
+  doc : string;
+  required : bool;
+  repeatable : bool;
+  choices : string Rrbvec.t;
+  (* value is a comma-separated list; choices complete each list element *)
+  multi : bool;
+  default : string option;
+}
+
+type command_meta = {
+  id : Command_id.t;
+  path : string Rrbvec.t;
+  doc : string;
+  long_doc : string option;
+  examples : string Rrbvec.t;
+  options : option_meta Rrbvec.t;
+  category : category;
+  requires_graph : bool;
+  requires_auth : bool;
+  write_command : bool;
+  human_table_headers_order : string Rrbvec.t;
+}
+
+type group_meta = {
+  name : string;
+  doc : string;
+  category : category;
+  children : string Rrbvec.t Rrbvec.t;
+}
+
+type t = { commands : command_meta Rrbvec.t; groups : group_meta Rrbvec.t }
+
+let append_all values = Array.fold_left Vec.append Vec.empty values
+
+let option ?(required = false) ?(repeatable = false) ?(choices = Vec.empty)
+    ?(multi = false) ?default names arity doc =
+  { names; arity; doc; required; repeatable; choices; multi; default }
+
+let option_of_array ?required ?repeatable ?choices ?multi ?default names arity
+    doc =
+  option ?required ?repeatable ?choices ?multi ?default (Vec.of_array names)
+    arity doc
+
+let flag ?required ?repeatable ?choices ?multi ?default name doc =
+  option ?required ?repeatable ?choices ?multi ?default
+    (Vec.singleton ("--" ^ name))
+    Flag doc
+
+let value ?required ?repeatable ?choices ?multi ?default name value_name doc =
+  option ?required ?repeatable ?choices ?multi ?default
+    (Vec.singleton ("--" ^ name))
+    (Required_value value_name) doc
+
+let optional_value ?required ?repeatable ?choices ?multi ?default name
+    value_name doc =
+  option ?required ?repeatable ?choices ?multi ?default
+    (Vec.singleton ("--" ^ name))
+    (Optional_value value_name) doc
+
+let output_choices = Vec.of_array [| "human"; "json"; "edn" |]
+let order_choices = Vec.of_array [| "asc"; "desc" |]
+let graph_data_choices = Vec.of_array [| "edn"; "sqlite" |]
+let position_choices = Vec.of_array [| "first-child"; "last-child"; "sibling" |]
+
+let property_type_choices =
+  Vec.of_array [| "default"; "number"; "date"; "checkbox"; "url" |]
+
+let cardinality_choices = Vec.of_array [| "one"; "many" |]
+
+let list_page_sort_choices =
+  Vec.of_array [| "id"; "title"; "ident"; "uuid"; "created-at"; "updated-at" |]
+
+let list_tag_sort_choices =
+  Vec.of_array
+    [|
+      "id";
+      "title";
+      "ident";
+      "uuid";
+      "properties";
+      "extends";
+      "description";
+      "created-at";
+      "updated-at";
+    |]
+
+let list_property_sort_choices =
+  Vec.of_array
+    [|
+      "id";
+      "title";
+      "ident";
+      "uuid";
+      "classes";
+      "type";
+      "cardinality";
+      "description";
+      "created-at";
+      "updated-at";
+    |]
+
+let list_task_sort_choices =
+  Vec.of_array
+    [|
+      "id";
+      "title";
+      "status";
+      "priority";
+      "scheduled";
+      "deadline";
+      "created-at";
+      "updated-at";
+    |]
+
+let list_node_sort_choices =
+  Vec.of_array
+    [|
+      "id"; "title"; "type"; "page-id"; "page-title"; "created-at"; "updated-at";
+    |]
+
+let list_asset_sort_choices =
+  Vec.of_array
+    [| "id"; "title"; "asset-type"; "size"; "created-at"; "updated-at" |]
+
+let search_result_header_order = Vec.of_array [| "id"; "ident"; "title" |]
+
+let human_table_headers_order_for_command = function
+  | Command_id.List_page -> list_page_sort_choices
+  | List_tag -> list_tag_sort_choices
+  | List_property -> list_property_sort_choices
+  | List_task -> list_task_sort_choices
+  | List_node -> list_node_sort_choices
+  | List_asset ->
+      Vec.of_array
+        [|
+          "id";
+          "title";
+          "size";
+          "type";
+          "checksum";
+          "remote-metadata";
+          "created-at";
+          "updated-at";
+        |]
+  | Search_block | Search_page | Search_property | Search_tag ->
+      search_result_header_order
+  | _ -> Vec.empty
+
+let global_options =
+  Vec.of_array
+    [|
+      option (Vec.singleton "--config") (Required_value "path")
+        "Path to cli.edn (default <root-dir>/cli.edn)";
+      option_of_array [| "-g"; "--graph" |] (Required_value "graph")
+        "Graph name";
+      option
+        (Vec.singleton "--root-dir")
+        (Required_value "path") "Path to CLI root dir (default ~/logseq)";
+      option
+        (Vec.singleton "--timeout-ms")
+        (Required_value "ms") "Request timeout in ms (default 10000)";
+      option_of_array [| "-o"; "--output" |] (Required_value "mode")
+        ~choices:output_choices ~default:"human" "Output format";
+      option_of_array [| "-v"; "--verbose" |] Flag
+        "Enable verbose debug logging to stderr";
+      option
+        (Vec.singleton "--profile")
+        Flag "Enable stage timing profile output to stderr";
+      option_of_array [| "-h"; "--help" |] Flag "Show command help";
+      option (Vec.singleton "--version") Flag "Show CLI version";
+    |]
+
+let common_list_options sort_choices =
+  Vec.of_array
+    [|
+      value "fields" "fields" "Comma-separated fields to include"
+        ~choices:sort_choices ~multi:true;
+      value "limit" "n" "Maximum result count";
+      value "offset" "n" "Result offset";
+      value "sort" "field" "Sort field" ~choices:sort_choices;
+      value "order" "order" "Sort order" ~choices:order_choices;
+    |]
+
+let selector_options =
+  Vec.of_array
+    [| value "id" "id" "Entity id"; value "uuid" "uuid" "Entity UUID" |]
+
+let target_options =
+  Vec.of_array
+    [|
+      value "target-id" "id" "Target block id";
+      value "target-uuid" "uuid" "Target block UUID";
+      value "target-page" "page" "Target page name";
+      value "pos" "position" "Insert position" ~choices:position_choices;
+    |]
+
+let property_update_options =
+  Vec.of_array
+    [|
+      value "update-tags" "edn" "Tags to add or update";
+      value "update-properties" "edn" "Properties to add or update";
+      value "remove-tags" "edn" "Tags to remove";
+      value "remove-properties" "edn" "Properties to remove";
+    |]
+
+let content_search_options =
+  Vec.singleton (value "content" "text" "Content search text")
+
+let e2ee_password_option = value "e2ee-password" "password" "E2EE password"
+
+let options_for_command =
+  let empty = Vec.empty in
+  function
+  | Command_id.Version | Graph_list | Graph_switch | Graph_remove | Graph_info
+  | Graph_backup_list ->
+      empty
+  | Graph_create ->
+      Vec.of_array [| flag "enable-sync" "Enable sync"; e2ee_password_option |]
+  | Graph_validate ->
+      Vec.singleton
+        (option_of_array [| "-f"; "--fix" |] Flag "Fix validation problems")
+  | Graph_backup_create -> Vec.singleton (value "name" "name" "Backup name")
+  | Graph_backup_restore ->
+      Vec.of_array
+        [|
+          value ~required:true "src" "backup" "Source backup name";
+          value ~required:true "dst" "graph" "Destination graph name";
+        |]
+  | Graph_backup_remove ->
+      Vec.singleton (value ~required:true "src" "backup" "Source backup name")
+  | Graph_export ->
+      Vec.of_array
+        [|
+          value "type" "type" "Export type" ~choices:graph_data_choices;
+          option_of_array [| "-f"; "--file" |] (Required_value "path")
+            "Output file";
+          option_of_array
+            [| "-e"; "--edn-options" |]
+            (Required_value "edn")
+            "EDN map of export options; :export-type overrides the default \
+             :graph";
+          option_of_array
+            [| "-p"; "--pretty-print" |]
+            Flag "Pretty-print the exported EDN file";
+        |]
+  | Graph_import ->
+      Vec.of_array
+        [|
+          value ~required:true "type" "type" "Import type"
+            ~choices:graph_data_choices;
+          value ~required:true "input" "path" "Input file";
+        |]
+  | List_page ->
+      Vec.append_array
+        (common_list_options list_page_sort_choices)
+        [|
+          option_of_array [| "-e"; "--expand" |] Flag "Expand page data";
+          optional_value "include-built-in" "bool" "Include built-in pages";
+          optional_value "include-journal" "bool" "Include journal pages";
+          flag "journal-only" "Only include journal pages";
+          flag "include-hidden" "Include hidden pages";
+          value "updated-after" "timestamp"
+            "Only include pages updated after timestamp";
+          value "created-after" "timestamp"
+            "Only include pages created after timestamp";
+        |]
+  | List_tag ->
+      Vec.append_array
+        (common_list_options list_tag_sort_choices)
+        [|
+          option_of_array [| "-e"; "--expand" |] Flag "Expand tag data";
+          optional_value "include-built-in" "bool" "Include built-in tags";
+          flag "with-properties" "Include properties";
+          flag "with-extends" "Include extends data";
+        |]
+  | List_property ->
+      Vec.append_array
+        (common_list_options list_property_sort_choices)
+        [|
+          option_of_array [| "-e"; "--expand" |] Flag "Expand property data";
+          optional_value "include-built-in" "bool" "Include built-in properties";
+          flag "with-classes" "Include classes";
+          flag "with-type" "Include property type";
+        |]
+  | List_task ->
+      Vec.append_array
+        (common_list_options list_task_sort_choices)
+        [|
+          value "status" "status" "Task status";
+          value "priority" "priority" "Task priority";
+          value "content" "text" "Task content filter";
+        |]
+  | List_node ->
+      Vec.append_array
+        (common_list_options list_node_sort_choices)
+        [|
+          value "tags" "tags" "Comma-separated tag filters" ~multi:true;
+          value "properties" "properties" "Comma-separated property filters"
+            ~multi:true;
+        |]
+  | List_asset -> common_list_options list_asset_sort_choices
+  | Remove_block -> selector_options
+  | Remove_page ->
+      Vec.of_array
+        [| value "id" "id" "Page id"; value "page" "page" "Page name" |]
+  | Remove_tag | Remove_property ->
+      Vec.of_array
+        [| value "id" "id" "Entity id"; value "name" "name" "Entity name" |]
+  | Upsert_block ->
+      append_all
+        [|
+          selector_options;
+          target_options;
+          Vec.of_array
+            [|
+              value "content" "text" "Block content";
+              value "blocks" "edn" "Blocks EDN";
+              value "blocks-file" "path" "Path to blocks EDN file";
+            |];
+          property_update_options;
+        |]
+  | Upsert_page ->
+      append_all
+        [|
+          Vec.of_array
+            [|
+              value "id" "id" "Page id";
+              value "page" "page" "Page name";
+              flag "restore" "Restore recycled page before updating";
+            |];
+          property_update_options;
+        |]
+  | Upsert_asset ->
+      append_all
+        [|
+          selector_options;
+          Vec.singleton (value "path" "path" "Asset path");
+          target_options;
+          Vec.singleton (value "content" "text" "Asset content");
+        |]
+  | Upsert_task ->
+      append_all
+        [|
+          selector_options;
+          Vec.of_array
+            [|
+              value "page" "page" "Page name";
+              value "content" "text" "Task content";
+            |];
+          target_options;
+          Vec.of_array
+            [|
+              value "status" "status" "Task status";
+              value "priority" "priority" "Task priority";
+              value "scheduled" "date" "Scheduled date";
+              value "deadline" "date" "Deadline date";
+              flag "no-status" "Remove status";
+              flag "no-priority" "Remove priority";
+              flag "no-scheduled" "Remove scheduled date";
+              flag "no-deadline" "Remove deadline date";
+            |];
+        |]
+  | Upsert_tag ->
+      Vec.of_array
+        [|
+          value "id" "id" "Tag id";
+          value "name" "name" "Tag name";
+          value "add-properties" "edn" "Tag schema properties to add";
+          value "remove-properties" "edn" "Tag schema properties to remove";
+        |]
+  | Upsert_property ->
+      Vec.of_array
+        [|
+          value "id" "id" "Property id";
+          value "name" "name" "Property name";
+          value "type" "type" "Property type" ~choices:property_type_choices;
+          value "cardinality" "cardinality" "Property cardinality"
+            ~choices:cardinality_choices;
+          optional_value "hide" "bool" "Hide property";
+          optional_value "public" "bool" "Make property public";
+        |]
+  | Search_block | Search_page | Search_property | Search_tag ->
+      content_search_options
+  | Query_list -> empty
+  | Query ->
+      Vec.of_array
+        [|
+          value "query" "edn" "Datascript query";
+          value "name" "name" "Saved query name";
+          value "inputs" "edn" "Query inputs";
+        |]
+  | Show ->
+      Vec.of_array
+        [|
+          optional_value "id" "id" "Entity id";
+          value "uuid" "uuid" "Entity UUID";
+          value "page" "page" "Page name";
+          optional_value "page-hierarchy" "bool" "Show page hierarchy";
+          optional_value "linked-references" "bool" "Show linked references";
+          optional_value "ref-id-footer" "bool" "Show reference id footer";
+          value "level" "n" "Tree depth";
+        |]
+  | Server_list | Server_cleanup | Server_start | Server_stop | Server_restart
+  | Sync_status | Sync_stop | Sync_remote_graphs | Sync_config_get
+  | Sync_config_unset | Sync_config_set | Login | Logout | Agent_bridge
+  | Example | Skill_show ->
+      empty
+  | Sync_start | Sync_upload -> Vec.singleton e2ee_password_option
+  | Sync_download ->
+      Vec.of_array [| flag "progress" "Stream progress"; e2ee_password_option |]
+  | Sync_asset_download -> selector_options
+  | Sync_ensure_keys ->
+      Vec.of_array
+        [| e2ee_password_option; flag "upload-keys" "Upload sync keys" |]
+  | Sync_grant_access ->
+      Vec.of_array
+        [|
+          value "graph-id" "graph-id" "Remote graph id";
+          value "email" "email" "Account email";
+        |]
+  | Debug_pull ->
+      Vec.push_back selector_options (value "ident" "ident" "Entity ident")
+  | Doctor -> Vec.singleton (flag "dev-script" "Use development script")
+  | Completion ->
+      Vec.singleton
+        (value "shell" "shell" "Completion shell"
+           ~choices:(Vec.of_array [| "zsh"; "bash" |]))
+  | Skill_install -> Vec.singleton (flag "global" "Install globally")
+
+let with_catalog_options command =
+  let options =
+    if Vec.is_empty command.options then options_for_command command.id
+    else command.options
+  in
+  let human_table_headers_order =
+    if Vec.is_empty command.human_table_headers_order then
+      human_table_headers_order_for_command command.id
+    else command.human_table_headers_order
+  in
+  { command with options; human_table_headers_order }
+
+let empty = { commands = Vec.empty; groups = Vec.empty }
+
+let make commands =
+  { commands = Vec.map with_catalog_options commands; groups = Vec.empty }
+
+let add command t =
+  { t with commands = Vec.push_front t.commands (with_catalog_options command) }
+
+let find_by_path path t =
+  Vec.find_opt (fun c -> Vec.equal String.equal c.path path) t.commands
+
+let top_level_group_doc = function
+  | "agent" -> Some "Agent bridge commands"
+  | "debug" -> Some "Debug commands"
+  | "graph" -> Some "Manage graphs"
+  | "list" -> Some "List graph entities"
+  | "remove" -> Some "Remove graph entities"
+  | "search" -> Some "Search graph entities"
+  | "server" -> Some "Manage db-worker-node servers"
+  | "skill" -> Some "Manage built-in logseq-cli skill"
+  | "sync" -> Some "Manage Logseq sync"
+  | "upsert" -> Some "Create or update graph entities"
+  | _ -> None
+
+let is_prefix prefix path =
+  let rec loop index =
+    index = Vec.length prefix
+    || (Vec.nth prefix index = Vec.nth path index && loop (index + 1))
+  in
+  Vec.length prefix <= Vec.length path && loop 0
+
+let option_label option =
+  let names = Vec.string_concat ", " option.names in
+  match option.arity with
+  | Flag -> names
+  | Required_value value_name -> names ^ " <" ^ value_name ^ ">"
+  | Optional_value value_name -> names ^ " [<" ^ value_name ^ ">]"
+
+let option_doc option =
+  let suffixes =
+    Vec.append
+      (if Vec.is_empty option.choices then Vec.empty
+       else Vec.singleton ("choices: " ^ Vec.string_concat ", " option.choices))
+      (match option.default with
+      | None -> Vec.empty
+      | Some default -> Vec.singleton ("default: " ^ default))
+  in
+  if Vec.is_empty suffixes then option.doc
+  else option.doc ^ " (" ^ Vec.string_concat "; " suffixes ^ ")"
+
+let format_rows rows =
+  let width =
+    rows |> Vec.fold_left (fun acc (name, _) -> max acc (String.length name)) 0
+  in
+  rows
+  |> Vec.map (fun (name, doc) ->
+      let padding = String.make (max 0 (width - String.length name)) ' ' in
+      if doc = "" then "  " ^ name else "  " ^ name ^ padding ^ "  " ^ doc)
+  |> Vec.string_concat "\n"
+
+let format_options options =
+  options
+  |> Vec.map (fun option -> (option_label option, option_doc option))
+  |> format_rows
+
+let render_help ?group (t : t) =
+  let join_words words = Vec.string_concat " " words in
+  let command_label command = join_words command.path in
+  let global_options_help = format_options global_options in
+  let top_level_entries () =
+    let seen = Hashtbl.create 16 in
+    let doc_for_top top fallback =
+      match find_by_path (Vec.singleton top) t with
+      | Some command -> command.doc
+      | None -> Option.value (top_level_group_doc top) ~default:fallback
+    in
+    t.commands
+    |> Vec.filter_map (fun command ->
+        match Vec.nth_opt command.path 0 with
+        | Some top when not (Hashtbl.mem seen top) ->
+            Hashtbl.add seen top ();
+            Some (top, doc_for_top top command.doc)
+        | _ -> None)
+  in
+  let top_level_help () =
+    Vec.string_concat "\n"
+      (Vec.of_array
+         [|
+           "Usage: logseq <command> [options]";
+           "";
+           "Commands:";
+           format_rows (top_level_entries ());
+           "";
+           "Available commands:";
+           format_rows
+             (t.commands
+             |> Vec.filter (fun (command : command_meta) ->
+                 command.category <> Hidden)
+             |> Vec.map (fun (command : command_meta) ->
+                 (command_label command, command.doc)));
+           "";
+           "Global options:";
+           global_options_help;
+           "";
+           "Command options:";
+           "  See `logseq <command> --help`";
+         |])
+  in
+  let group_help group =
+    let rows =
+      t.commands
+      |> Vec.filter (fun command -> is_prefix group command.path)
+      |> Vec.map (fun command -> (command_label command, command.doc))
+    in
+    Vec.string_concat "\n"
+      (Vec.of_array
+         [|
+           "Usage: logseq " ^ join_words group ^ " <subcommand> [options]";
+           "";
+           "Subcommands:";
+           format_rows rows;
+           "";
+           "Global options:";
+           global_options_help;
+           "";
+           "Command options:";
+           "  See `logseq " ^ join_words group ^ " <subcommand> --help`";
+         |])
+  in
+  let command_options_help command =
+    if Vec.is_empty command.options then "  None"
+    else format_options command.options
+  in
+  let command_help command =
+    let examples =
+      if Vec.is_empty command.examples then Vec.empty
+      else
+        Vec.prepend_array
+          (command.examples |> Vec.map (fun example -> "  " ^ example))
+          [| ""; "Examples:" |]
+    in
+    Vec.string_concat "\n"
+      (Vec.prepend_array examples
+         [|
+           "Usage: logseq " ^ command_label command ^ " [options]";
+           "";
+           "Global options:";
+           global_options_help;
+           "";
+           "Command options:";
+           command_options_help command;
+         |])
+  in
+  match group with
+  | None -> top_level_help ()
+  | Some group when Vec.is_empty group -> top_level_help ()
+  | Some group -> (
+      match find_by_path group t with
+      | Some command -> command_help command
+      | None -> group_help group)

cli/lib/completion.ml

@@ -0,0 +1,517 @@
+type opts = { shell : Cli_primitive.shell option }
+type parsed = Parsed_completion of opts
+
+type action =
+  | Completion of {
+      shell : Cli_primitive.shell;
+      registry : Command_registry.t option;
+    }
+
+let join_words words = Vec.string_concat " " words
+
+let unique_preserve values =
+  let seen = Hashtbl.create 16 in
+  values
+  |> Vec.filter (fun value ->
+      if Hashtbl.mem seen value then false
+      else (
+        Hashtbl.add seen value ();
+        true))
+
+let top_command_names registry =
+  registry.Command_registry.commands
+  |> Vec.filter_map (fun command -> Vec.nth_opt command.Command_registry.path 0)
+  |> Vec.sort_uniq String.compare
+
+let is_prefix prefix path =
+  let rec loop index =
+    index = Vec.length prefix
+    || (Vec.nth prefix index = Vec.nth path index && loop (index + 1))
+  in
+  Vec.length prefix <= Vec.length path && loop 0
+
+let commands_under registry prefix =
+  registry.Command_registry.commands
+  |> Vec.filter (fun command ->
+      is_prefix prefix command.Command_registry.path
+      && Vec.length command.Command_registry.path > Vec.length prefix)
+
+let direct_children registry prefix =
+  let prefix_len = Vec.length prefix in
+  commands_under registry prefix
+  |> Vec.filter_map (fun command ->
+      Vec.nth_opt command.Command_registry.path prefix_len)
+  |> unique_preserve
+
+let direct_leaf_children registry prefix =
+  let prefix_len = Vec.length prefix in
+  commands_under registry prefix
+  |> Vec.filter (fun command ->
+      Vec.length command.Command_registry.path = prefix_len + 1)
+
+let nested_child_groups registry prefix =
+  let prefix_len = Vec.length prefix in
+  commands_under registry prefix
+  |> Vec.filter_map (fun command ->
+      if Vec.length command.Command_registry.path > prefix_len + 1 then
+        Vec.nth_opt command.Command_registry.path prefix_len
+      else None)
+  |> unique_preserve
+
+let is_group registry path = not (Vec.is_empty (commands_under registry path))
+
+let global_option_names =
+  Vec.of_array
+    [|
+      "--help";
+      "-h";
+      "--version";
+      "--config";
+      "--graph";
+      "-g";
+      "--root-dir";
+      "--timeout-ms";
+      "--output";
+      "-o";
+      "--verbose";
+      "-v";
+      "--profile";
+    |]
+
+let global_value_option_names =
+  Vec.of_array
+    [|
+      "--config";
+      "--graph";
+      "-g";
+      "--root-dir";
+      "--timeout-ms";
+      "--output";
+      "-o";
+    |]
+
+let command_desc_for_path registry path =
+  Command_registry.find_by_path path registry
+  |> Option.map (fun (command : Command_registry.command_meta) -> command.doc)
+  |> Option.value ~default:""
+
+let zsh_quote_entry name desc = "'" ^ name ^ ":" ^ desc ^ "'"
+
+let zsh_escape_desc doc =
+  let buffer = Buffer.create (String.length doc) in
+  String.iter
+    (fun c ->
+      match c with
+      | '\'' -> Buffer.add_string buffer "'\\''"
+      | '[' -> Buffer.add_string buffer "\\["
+      | ']' -> Buffer.add_string buffer "\\]"
+      | c -> Buffer.add_char buffer c)
+    doc;
+  Buffer.contents buffer
+
+let zsh_option_action (option : Command_registry.option_meta) value_name =
+  if Vec.mem "--graph" option.names then "{_logseq_graphs}"
+  else if option.multi && not (Vec.is_empty option.choices) then
+    "{_values -s , " ^ value_name ^ " " ^ Vec.string_concat " " option.choices
+    ^ "}"
+  else if not (Vec.is_empty option.choices) then
+    "(" ^ Vec.string_concat " " option.choices ^ ")"
+  else if Vec.mem "--root-dir" option.names then "_files -/"
+  else if value_name = "path" then "_files"
+  else if value_name = "bool" then "(true false)"
+  else ""
+
+let zsh_option_spec (option : Command_registry.option_meta) =
+  let desc = "[" ^ zsh_escape_desc option.doc ^ "]" in
+  let value_spec =
+    match option.arity with
+    | Command_registry.Flag -> None
+    | Required_value name ->
+        Some (":" ^ name ^ ":" ^ zsh_option_action option name)
+    | Optional_value name ->
+        Some ("::" ^ name ^ ":" ^ zsh_option_action option name)
+  in
+  let name_suffix = if Option.is_some value_spec then "=" else "" in
+  let arg = Option.value value_spec ~default:"" in
+  let star = if option.repeatable then "*" else "" in
+  if Vec.length option.names = 1 then
+    "'" ^ star ^ Vec.nth option.names 0 ^ name_suffix ^ desc ^ arg ^ "'"
+  else
+    let exclusion =
+      if option.repeatable then "'" ^ star ^ "'"
+      else "'(" ^ Vec.string_concat " " option.names ^ ")'"
+    in
+    let alternatives =
+      option.names
+      |> Vec.map (fun name -> name ^ name_suffix)
+      |> Vec.string_concat ","
+    in
+    exclusion ^ "{" ^ alternatives ^ "}'" ^ desc ^ arg ^ "'"
+
+let global_option_named name =
+  Command_registry.global_options
+  |> Vec.find_opt (fun (option : Command_registry.option_meta) ->
+      Vec.mem name option.names)
+
+let zsh_global_specs names =
+  names |> Vec.filter_map global_option_named |> Vec.map zsh_option_spec
+
+let zsh_spec_lines specs = "    " ^ Vec.string_concat " \\\n    " specs
+
+let zsh_leaf_function command =
+  let func_name = "_logseq_" ^ join_words command.Command_registry.path in
+  let func_name = String.map (function ' ' -> '_' | c -> c) func_name in
+  let specs =
+    Vec.append
+      (zsh_global_specs (Vec.of_array [| "--help"; "--graph"; "--output" |]))
+      (Vec.map zsh_option_spec command.Command_registry.options)
+  in
+  String.concat "\n"
+    [ func_name ^ "() {"; "  _arguments \\"; zsh_spec_lines specs; "}"; "" ]
+
+let zsh_group_specs registry path =
+  let own_option_specs =
+    match Command_registry.find_by_path path registry with
+    | Some command -> Vec.map zsh_option_spec command.Command_registry.options
+    | None -> Vec.empty
+  in
+  Vec.append
+    (Vec.append
+       (zsh_global_specs (Vec.of_array [| "--help"; "--graph" |]))
+       own_option_specs)
+    (Vec.of_array [| "'(-)1:subcommand:->subcmd'"; "'(-)*::args:->args'" |])
+
+let zsh_subgroup_function registry parent subgroup =
+  let prefix = Vec.push_back parent subgroup in
+  let child_entries =
+    direct_leaf_children registry prefix
+    |> Vec.map (fun command ->
+        "        "
+        ^ zsh_quote_entry
+            (Vec.nth command.Command_registry.path (Vec.length prefix))
+            command.Command_registry.doc)
+    |> Vec.string_concat "\n"
+  in
+  let dispatches =
+    direct_leaf_children registry prefix
+    |> Vec.map (fun command ->
+        let leaf = Vec.nth command.Command_registry.path (Vec.length prefix) in
+        "        " ^ leaf ^ ") _logseq_"
+        ^ Vec.string_concat "_" command.Command_registry.path
+        ^ " ;;")
+    |> Vec.string_concat "\n"
+  in
+  String.concat "\n"
+    [
+      "_logseq_" ^ Vec.string_concat "_" prefix ^ "() {";
+      "  local curcontext=\"$curcontext\" state line";
+      "  typeset -A opt_args";
+      "  _arguments -C \\";
+      zsh_spec_lines (zsh_group_specs registry prefix);
+      "  case $state in";
+      "    subcmd)";
+      "      local -a subcmds";
+      "      subcmds=(";
+      child_entries;
+      "      )";
+      "      _describe 'subcommand' subcmds";
+      "      ;;";
+      "    args)";
+      "      case $line[1] in";
+      dispatches;
+      "      esac";
+      "      ;;";
+      "  esac";
+      "}";
+      "";
+    ]
+
+let zsh_group_function registry group =
+  let prefix = Vec.singleton group in
+  let leaf_entries =
+    direct_leaf_children registry prefix
+    |> Vec.map (fun command ->
+        "        "
+        ^ zsh_quote_entry
+            (Vec.nth command.Command_registry.path 1)
+            command.Command_registry.doc)
+  in
+  let subgroup_entries =
+    nested_child_groups registry prefix
+    |> Vec.map (fun name ->
+        "        " ^ zsh_quote_entry name (name ^ " commands"))
+  in
+  let dispatches =
+    direct_leaf_children registry prefix
+    |> Vec.map (fun command ->
+        let subcmd = Vec.nth command.Command_registry.path 1 in
+        "        " ^ subcmd ^ ") _logseq_"
+        ^ Vec.string_concat "_" command.Command_registry.path
+        ^ " ;;")
+    |> fun leaf_dispatches ->
+    Vec.append leaf_dispatches
+      (nested_child_groups registry prefix
+      |> Vec.map (fun name ->
+          "        " ^ name ^ ") _logseq_" ^ group ^ "_" ^ name ^ " ;;"))
+  in
+  let subgroup_functions =
+    nested_child_groups registry prefix
+    |> Vec.map (zsh_subgroup_function registry prefix)
+    |> Vec.string_concat "\n"
+  in
+  subgroup_functions
+  ^ String.concat "\n"
+      [
+        "_logseq_" ^ group ^ "() {";
+        "  local curcontext=\"$curcontext\" state line";
+        "  typeset -A opt_args";
+        "  _arguments -C \\";
+        zsh_spec_lines (zsh_group_specs registry prefix);
+        "  case $state in";
+        "    subcmd)";
+        "      local -a subcmds";
+        "      subcmds=(";
+        Vec.string_concat "\n" (Vec.append leaf_entries subgroup_entries);
+        "      )";
+        "      _describe 'subcommand' subcmds";
+        "      ;;";
+        "    args)";
+        "      case $line[1] in";
+        Vec.string_concat "\n" dispatches;
+        "      esac";
+        "      ;;";
+        "  esac";
+        "}";
+        "";
+      ]
+
+let generate_zsh_completion registry =
+  let top_entries =
+    top_command_names registry
+    |> Vec.map (fun top ->
+        let desc =
+          let path = Vec.singleton top in
+          if is_group registry path then top ^ " commands"
+          else command_desc_for_path registry path
+        in
+        "        " ^ zsh_quote_entry top desc)
+    |> Vec.string_concat "\n"
+  in
+  let dispatches =
+    top_command_names registry
+    |> Vec.map (fun top -> "        " ^ top ^ ") _logseq_" ^ top ^ " ;;")
+    |> Vec.string_concat "\n"
+  in
+  let leaf_functions =
+    registry.Command_registry.commands
+    |> Vec.filter (fun command ->
+        (* commands that are also groups (e.g. `query`) are completed by
+           their group dispatcher, which includes their options *)
+        not (is_group registry command.Command_registry.path))
+    |> Vec.map zsh_leaf_function |> Vec.string_concat "\n"
+  in
+  let group_functions =
+    top_command_names registry
+    |> Vec.filter (fun top -> is_group registry (Vec.singleton top))
+    |> Vec.map (zsh_group_function registry)
+    |> Vec.string_concat "\n"
+  in
+  String.concat "\n"
+    [
+      "#compdef logseq";
+      "# Auto-generated by `logseq completion zsh` - do not edit manually.";
+      "";
+      "_logseq_graphs() {";
+      "  local -a graphs";
+      "  graphs=( ${(f)\"$(logseq graph list --output json 2>/dev/null | node \
+       -e 'const fs = require(\"fs\"); const input = fs.readFileSync(0, \
+       \"utf8\"); if (!input.trim()) process.exit(0); const data = \
+       JSON.parse(input); const graphs = data && data.data && \
+       data.data.graphs; if (Array.isArray(graphs)) \
+       console.log(graphs.join(\"\\n\"));')\"} )";
+      "  compadd -a graphs";
+      "}";
+      "";
+      "# --- per-command functions ---";
+      "";
+      leaf_functions;
+      "# --- group dispatchers ---";
+      "";
+      group_functions;
+      "# --- top-level dispatcher ---";
+      "";
+      "_logseq() {";
+      "  local curcontext=\"$curcontext\" state line";
+      "  typeset -A opt_args";
+      "  _arguments -C \\";
+      zsh_spec_lines
+        (Vec.append
+           (Vec.map zsh_option_spec Command_registry.global_options)
+           (Vec.of_array
+              [| "'(-)1:command:->cmds'"; "'(-)*::args:->args'" |]));
+      "  case $state in";
+      "    cmds)";
+      "      local -a cmds";
+      "      cmds=(";
+      top_entries;
+      "      )";
+      "      _describe 'command' cmds";
+      "      ;;";
+      "    args)";
+      "      case $line[1] in";
+      dispatches;
+      "      esac";
+      "      ;;";
+      "  esac";
+      "}";
+      "";
+      "compdef _logseq logseq";
+    ]
+
+let bash_case_pattern names = Vec.string_concat "|" names
+
+let bash_subcommand_cases registry =
+  top_command_names registry
+  |> Vec.filter_map (fun top ->
+      let children = direct_children registry (Vec.singleton top) in
+      if Vec.is_empty children then None
+      else
+        Some
+          ("      " ^ top ^ ") COMPREPLY=( $(compgen -W '"
+          ^ Vec.string_concat " " children
+          ^ "' -- \"$cur\") ) ;;"))
+  |> Vec.string_concat "\n"
+
+let bash_sub_subcommand_cases registry =
+  top_command_names registry
+  |> Vec.concat_map (fun top ->
+      nested_child_groups registry (Vec.singleton top)
+      |> Vec.map (fun subgroup ->
+          let leaves =
+            direct_children registry (Vec.of_array [| top; subgroup |])
+          in
+          "      " ^ top ^ ":" ^ subgroup ^ ") COMPREPLY=( $(compgen -W '"
+          ^ Vec.string_concat " " leaves
+          ^ "' -- \"$cur\") ) ;;"))
+  |> Vec.string_concat "\n"
+
+let generate_bash_completion registry =
+  let top_commands = Vec.string_concat " " (top_command_names registry) in
+  String.concat "\n"
+    [
+      "# Auto-generated by `logseq completion bash` - do not edit manually.";
+      "";
+      "_logseq_is_value_opt() {";
+      "  case \"$1\" in";
+      "    " ^ bash_case_pattern global_value_option_names ^ ")";
+      "      return 0 ;;";
+      "    *) return 1 ;;";
+      "  esac";
+      "}";
+      "";
+      "_logseq_cmd_and_subcmd() {";
+      "  local i skip=0";
+      "  __cmd='' __subcmd='' __subsubcmd=''";
+      "  for (( i = 1; i < COMP_CWORD; i++ )); do";
+      "    local w=\"${COMP_WORDS[i]}\"";
+      "    if (( skip )); then skip=0; continue; fi";
+      "    if [[ \"$w\" == -* ]]; then";
+      "      _logseq_is_value_opt \"$w\" && skip=1";
+      "      continue";
+      "    fi";
+      "    if [[ -z \"$__cmd\" ]]; then __cmd=\"$w\"";
+      "    elif [[ -z \"$__subcmd\" ]]; then __subcmd=\"$w\"";
+      "    elif [[ -z \"$__subsubcmd\" ]]; then __subsubcmd=\"$w\"";
+      "    fi";
+      "  done";
+      "}";
+      "";
+      "_logseq_json_names_bash() {";
+      "  logseq graph list --output json 2>/dev/null | node -e 'const fs = \
+       require(\"fs\"); const input = fs.readFileSync(0, \"utf8\"); if \
+       (!input.trim()) process.exit(0); const data = JSON.parse(input); const \
+       graphs = data && data.data && data.data.graphs; if \
+       (Array.isArray(graphs)) console.log(graphs.join(\" \"));'";
+      "}";
+      "";
+      "_logseq_opts_for() {";
+      "  printf '%s' \"" ^ Vec.string_concat " " global_option_names ^ "\"";
+      "}";
+      "";
+      "_logseq() {";
+      "  local cur prev";
+      "  cur=\"${COMP_WORDS[COMP_CWORD]}\"";
+      "  prev=\"${COMP_WORDS[COMP_CWORD-1]}\"";
+      "  COMPREPLY=()";
+      "  local __cmd __subcmd __subsubcmd";
+      "  _logseq_cmd_and_subcmd";
+      "  if [[ \"$cur\" == -* ]]; then";
+      "    COMPREPLY=( $(compgen -W \"$(_logseq_opts_for \"$__cmd\" \
+       \"$__subcmd\" \"$__subsubcmd\")\" -- \"$cur\") )";
+      "    return";
+      "  fi";
+      "  if [[ -z \"$__cmd\" ]]; then";
+      "    COMPREPLY=( $(compgen -W '" ^ top_commands ^ "' -- \"$cur\") )";
+      "    return";
+      "  fi";
+      "  if [[ -z \"$__subcmd\" ]]; then";
+      "    case \"$__cmd\" in";
+      bash_subcommand_cases registry;
+      "    esac";
+      "    return";
+      "  fi";
+      "  if [[ -z \"$__subsubcmd\" ]]; then";
+      "    case \"$__cmd:$__subcmd\" in";
+      bash_sub_subcommand_cases registry;
+      "    esac";
+      "    return";
+      "  fi";
+      "}";
+      "";
+      "complete -F _logseq logseq";
+    ]
+
+let generate shell registry =
+  match shell with
+  | Cli_primitive.Zsh -> generate_zsh_completion registry
+  | Bash -> generate_bash_completion registry
+
+let command_id _ = Command_id.Completion
+let validate_parsed _ = Ok ()
+
+let build ?registry _config _ = function
+  | Parsed_completion { shell = Some shell } ->
+      Ok (Completion { shell; registry })
+  | Parsed_completion { shell = None } ->
+      Error
+        (Error.invalid_options
+           "completion shell is required; expected zsh or bash")
+
+let execute_with_mode (Completion { shell; registry }) _config mode =
+  Cli_effect.pure
+    (Cli_result.ok ~command:Command_id.Completion mode
+       (Message
+          (generate shell
+             (Option.value registry ~default:Command_registry.empty))))
+
+let metadata () =
+  Vec.of_array
+    [|
+      {
+        Command_registry.id = Command_id.Completion;
+        path = Command_id.to_path Command_id.Completion;
+        doc = "Generate shell completion script";
+        long_doc = None;
+        examples = Vec.empty;
+        options = Vec.empty;
+        category = Command_registry.Utilities;
+        requires_graph = Command_id.requires_graph Command_id.Completion;
+        requires_auth = Command_id.requires_auth Command_id.Completion;
+        write_command = Command_id.is_write Command_id.Completion;
+        human_table_headers_order = Vec.empty;
+      };
+    |]
+
+let execute action config =
+  let (Output.Mode.Packed mode) = Output_mode.for_config config in
+  execute_with_mode action config mode

cli/lib/db_worker_types.ml

@@ -0,0 +1,32 @@
+type list_options = Melange_edn_melange.any
+
+type page_filter = {
+  expand : bool;
+  include_hidden : bool;
+  include_built_in : bool;
+  include_journal : bool;
+  journal_only : bool;
+  created_after : Js.Date.t option;
+  updated_after : Js.Date.t option;
+}
+
+type node_filter = {
+  tag_ids : Cli_primitive.db_id Rrbvec.t;
+  property_idents : Cli_primitive.keyword Rrbvec.t;
+}
+
+let add_raw_field key raw fields =
+  match Edn_util.get raw key with
+  | None -> fields
+  | Some value -> Vec.push_front fields (Edn_util.keyword key, value)
+
+let minimal_list_item e =
+  Vec.empty
+  |> add_raw_field "logseq.property/type" e.Entity.raw
+  |> add_raw_field "db/cardinality" e.Entity.raw
+  |> add_raw_field "db/ident" e.Entity.raw
+  |> add_raw_field "block/updated-at" e.Entity.raw
+  |> add_raw_field "block/created-at" e.Entity.raw
+  |> add_raw_field "block/title" e.Entity.raw
+  |> add_raw_field "db/id" e.Entity.raw
+  |> fun fields -> Edn_util.map_t_vec fields

cli/lib/debug.ml

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

cli/lib/display_width.ml

@@ -0,0 +1,56 @@
+let is_combining code =
+  (code >= 0x0300 && code <= 0x036f)
+  || (code >= 0x1ab0 && code <= 0x1aff)
+  || (code >= 0x1dc0 && code <= 0x1dff)
+  || (code >= 0x20d0 && code <= 0x20ff)
+  || (code >= 0xfe20 && code <= 0xfe2f)
+
+let is_wide code =
+  code >= 0x1100
+  && (code <= 0x115f || code = 0x2329 || code = 0x232a
+     || (code >= 0x2e80 && code <= 0xa4cf && code <> 0x303f)
+     || (code >= 0xac00 && code <= 0xd7a3)
+     || (code >= 0xf900 && code <= 0xfaff)
+     || (code >= 0xfe10 && code <= 0xfe19)
+     || (code >= 0xfe30 && code <= 0xfe6f)
+     || (code >= 0xff00 && code <= 0xff60)
+     || (code >= 0xffe0 && code <= 0xffe6))
+
+let char_width code =
+  if code = 0 || code < 32 || (code >= 0x7f && code < 0xa0) then 0
+  else if is_combining code then 0
+  else if is_wide code then 2
+  else 1
+
+external chars_of_string : string -> string array = "from" [@@mel.scope "Array"]
+
+let unicode_chars text =
+  Ustring.(of_string text |> to_string) |> chars_of_string
+
+let code_point ch =
+  match Js.String.codePointAt ~index:0 ch with Some code -> code | None -> 0
+
+let width text =
+  unicode_chars text
+  |> Array.fold_left (fun acc ch -> acc + char_width (code_point ch)) 0
+
+let take text max_width =
+  let rec loop chars index acc_width acc =
+    if index >= Array.length chars then Vec.string_concat "" acc
+    else
+      let ch = chars.(index) in
+      let next_width = acc_width + char_width (code_point ch) in
+      if next_width > max_width then Vec.string_concat "" acc
+      else loop chars (index + 1) next_width (Vec.push_back acc ch)
+  in
+  if max_width <= 0 then "" else loop (unicode_chars text) 0 0 Vec.empty
+
+let ellipsis = Cli_platform.Symbols.ellipsis
+
+let truncate text max_width =
+  let max_width = max 1 max_width in
+  if width text <= max_width then text
+  else
+    let ellipsis_width = width ellipsis in
+    if max_width <= ellipsis_width then take ellipsis max_width
+    else take text (max_width - ellipsis_width) ^ ellipsis

cli/lib/doctor.ml

@@ -0,0 +1,270 @@
+type opts = { dev_script : bool }
+type parsed = Parsed_doctor of opts
+type action = Doctor of { script_path : Cli_primitive.path option }
+type check_status = Ok | Warning | Error
+
+type check = {
+  id : Cli_primitive.keyword;
+  status : check_status;
+  code : Error.code option;
+  message : string;
+  path : Cli_primitive.path option;
+  servers : Melange_edn_melange.any Rrbvec.t;
+  raw : Melange_edn_melange.any option;
+}
+
+type report = { status : check_status; checks : check Rrbvec.t }
+
+let command_id _ = Command_id.Doctor
+let validate_parsed _ = Stdlib.Ok ()
+
+let status_value = function
+  | Ok -> Edn_util.keyword "ok"
+  | Warning -> Edn_util.keyword "warning"
+  | Error -> Edn_util.keyword "error"
+
+let check_value (check : check) =
+  let fields =
+    Vec.of_array
+      [|
+        (Edn_util.keyword "id", Edn_util.any check.id);
+        (Edn_util.keyword "status", status_value check.status);
+        (Edn_util.keyword "message", Edn_util.string check.message);
+      |]
+  in
+  let fields =
+    match check.code with
+    | Some code ->
+        Vec.push_back fields
+          (Edn_util.keyword "code", Edn_util.any (Error.code_to_keyword code))
+    | None -> fields
+  in
+  let fields =
+    match check.path with
+    | Some path ->
+        Vec.push_back fields (Edn_util.keyword "path", Edn_util.string path)
+    | None -> fields
+  in
+  let fields =
+    if Vec.is_empty check.servers then fields
+    else
+      Vec.push_back fields
+        (Edn_util.keyword "servers", Edn_util.vector_vec check.servers)
+  in
+  let fields =
+    match check.raw with
+    | Some raw -> Vec.push_back fields (Edn_util.keyword "raw", raw)
+    | None -> fields
+  in
+  Edn_util.map_vec fields
+
+let check_db_worker_script (Doctor { script_path }) =
+  let path =
+    Option.value script_path
+      ~default:(Server_runtime.db_worker_runtime_script_path ())
+  in
+  if not (Cli_unix.file_exists path) then
+    {
+      id = Edn_util.keyword_t "db-worker-script";
+      status = Error;
+      code = Some Error.Doctor_script_missing;
+      message = "db-worker script is missing: " ^ path;
+      path = Some path;
+      servers = Vec.empty;
+      raw = None;
+    }
+  else if Cli_unix.is_directory path then
+    {
+      id = Edn_util.keyword_t "db-worker-script";
+      status = Error;
+      code = Some Error.Doctor_script_unreadable;
+      message = "db-worker script path is not a file: " ^ path;
+      path = Some path;
+      servers = Vec.empty;
+      raw = None;
+    }
+  else
+    try
+      ignore (Cli_unix.read_text_file path);
+      {
+        id = Edn_util.keyword_t "db-worker-script";
+        status = Ok;
+        code = None;
+        message = "Found readable file: " ^ path;
+        path = Some path;
+        servers = Vec.empty;
+        raw = None;
+      }
+    with exn ->
+      {
+        id = Edn_util.keyword_t "db-worker-script";
+        status = Error;
+        code = Some Error.Doctor_script_unreadable;
+        message =
+          "db-worker script is not readable: " ^ path ^ " ("
+          ^ Printexc.to_string exn ^ ")";
+        path = Some path;
+        servers = Vec.empty;
+        raw = None;
+      }
+
+let ensure_dir path =
+  if Cli_unix.file_exists path then () else Cli_unix.mkdir path 0o755
+
+let check_root_dir config =
+  let path = config.Cli_config.root_dir in
+  try
+    ensure_dir path;
+    let probe = Filename.concat path ".logseq-cli-doctor-check" in
+    Cli_unix.write_text_file probe "ok";
+    Cli_unix.remove_tree probe;
+    {
+      id = Edn_util.keyword_t "root-dir";
+      status = Ok;
+      code = None;
+      message = "Read/write access confirmed: " ^ path;
+      path = Some path;
+      servers = Vec.empty;
+      raw = None;
+    }
+  with exn ->
+    {
+      id = Edn_util.keyword_t "root-dir";
+      status = Error;
+      code = Some Error.Root_dir_permission;
+      message = "root-dir check failed: " ^ Printexc.to_string exn;
+      path = Some path;
+      servers = Vec.empty;
+      raw = None;
+    }
+
+let server_status_value = function
+  | Server_runtime.Starting -> Edn_util.keyword "starting"
+  | Server_runtime.Ready -> Edn_util.keyword "ready"
+  | Server_runtime.Error -> Edn_util.keyword "error"
+  | Server_runtime.Unknown -> Edn_util.keyword "unknown"
+
+let server_value (server : Server_runtime.server) =
+  Edn_util.map_vec
+    (Vec.of_array
+       [|
+         ( Edn_util.keyword "repo",
+           Edn_util.string (Cli_primitive.string_of_repo server.repo) );
+         ( Edn_util.keyword "graph",
+           match server.graph with
+           | Some graph -> Edn_util.string (Cli_primitive.string_of_graph graph)
+           | None -> Edn_util.nil );
+         (Edn_util.keyword "status", server_status_value server.status);
+         (Edn_util.keyword "base-url", Edn_util.string server.base_url);
+       |])
+
+let check_running_servers config =
+  Cli_effect.map
+    (fun servers ->
+      let starting =
+        Vec.filter
+          (fun (server : Server_runtime.server) ->
+            server.status = Server_runtime.Starting)
+          servers
+      in
+      if Vec.is_empty starting then
+        {
+          id = Edn_util.keyword_t "running-servers";
+          status = Ok;
+          code = None;
+          message =
+            (if Vec.is_empty servers then
+               "No running db-worker servers detected"
+             else "All running servers are ready");
+          path = None;
+          servers = Vec.map server_value servers;
+          raw = None;
+        }
+      else
+        {
+          id = Edn_util.keyword_t "running-servers";
+          status = Warning;
+          code = Some Error.Doctor_server_not_ready;
+          message =
+            Humanize_types.format_count_with_noun (Vec.length starting) "server"
+            ^ " still starting";
+          path = None;
+          servers = Vec.map server_value starting;
+          raw = None;
+        })
+    (Server_runtime.list_servers config)
+
+let report_status checks =
+  if Vec.exists (fun (check : check) -> check.status = Error) checks then Error
+  else if Vec.exists (fun (check : check) -> check.status = Warning) checks then
+    Warning
+  else Ok
+
+let report_value checks =
+  let status = report_status checks in
+  Edn_util.map_vec
+    (Vec.of_array
+       [|
+         (Edn_util.keyword "status", status_value status);
+         ( Edn_util.keyword "checks",
+           Edn_util.vector_vec (checks |> Vec.map check_value) );
+       |])
+
+let build ?registry:_ _ _ (Parsed_doctor opts) =
+  let script_path =
+    if opts.dev_script then Some (Filename.concat "static" "db-worker-node.js")
+    else None
+  in
+  Stdlib.Ok (Doctor { script_path })
+
+let execute_with_mode action config mode =
+  let script_check = check_db_worker_script action in
+  if script_check.status = Error then
+    Cli_effect.pure
+      (Output_mode.error ~command:Command_id.Doctor mode
+         ~context:(report_value (Vec.singleton script_check))
+         (Error.make
+            ~context:(report_value (Vec.singleton script_check))
+            (Option.value script_check.code ~default:Error.Doctor_error)
+            script_check.message))
+  else
+    let root_check = check_root_dir config in
+    if root_check.status = Error then
+      let checks = Vec.of_array [| script_check; root_check |] in
+      Cli_effect.pure
+        (Output_mode.error ~command:Command_id.Doctor mode
+           ~context:(report_value checks)
+           (Error.make ~context:(report_value checks)
+              (Option.value root_check.code ~default:Error.Doctor_error)
+              root_check.message))
+    else
+      Cli_effect.map
+        (fun server_check ->
+          let checks =
+            Vec.of_array [| script_check; root_check; server_check |]
+          in
+          Cli_result.ok ~command:Command_id.Doctor mode
+            (Raw (report_value checks)))
+        (check_running_servers config)
+
+let metadata () =
+  Vec.of_array
+    [|
+      {
+        Command_registry.id = Command_id.Doctor;
+        path = Command_id.to_path Command_id.Doctor;
+        doc = "Run CLI diagnostics";
+        long_doc = None;
+        examples = Vec.empty;
+        options = Vec.empty;
+        category = Command_registry.Utilities;
+        requires_graph = Command_id.requires_graph Command_id.Doctor;
+        requires_auth = Command_id.requires_auth Command_id.Doctor;
+        write_command = Command_id.is_write Command_id.Doctor;
+        human_table_headers_order = Vec.empty;
+      };
+    |]
+
+let execute action config =
+  let (Output.Mode.Packed mode) = Output_mode.for_config config in
+  execute_with_mode action config mode

cli/lib/dune

@@ -0,0 +1,15 @@
+(library
+ (name logseq_cli)
+ (implements logseq_cli_spec)
+ (modes melange)
+ (preprocess
+  (pps melange.ppx))
+ (libraries
+  logseq_cli_platform_spec
+  humanize
+  melange-fetch
+  melange-transit-melange
+  melange-edn-melange
+  rrbvec
+  melange.js
+  melange.node))

cli/lib/edn_util.ml

@@ -0,0 +1,189 @@
+let any = Melange_edn_melange.any
+let keyword_t value = Melange_edn_melange.keyword value
+
+let keyword_to_string
+    (value : Melange_edn_melange.keyword Melange_edn_melange.t) =
+  match value with
+  | Melange_edn_melange.Keyword value ->
+      Melange_edn_melange.keyword_to_string value
+
+let keyword_any value = any (keyword_t value)
+let list_t values = Melange_edn_melange.list values
+let vector_t values = Melange_edn_melange.vector values
+let set_t values = Melange_edn_melange.set values
+let map_t fields = Melange_edn_melange.map fields
+let nil = any Melange_edn_melange.nil
+let bool value = any (Melange_edn_melange.bool value)
+let int value = any (Melange_edn_melange.int (Int64.of_int value))
+let int64 value = any (Melange_edn_melange.int value)
+let float value = any (Melange_edn_melange.float value)
+let string value = any (Melange_edn_melange.string value)
+let symbol value = any (Melange_edn_melange.symbol value)
+let keyword value = any (keyword_t value)
+let uuid value = any (Melange_edn_melange.tagged "uuid" (string value))
+
+let bytes value =
+  any
+    (Melange_edn_melange.tagged "transit/bytes"
+       (string (Bytes.to_string value)))
+
+let list values = any (list_t values)
+let vector values = any (vector_t values)
+let set values = any (set_t values)
+let map fields = any (map_t fields)
+let list_t_vec values = list_t (Vec.to_list values)
+let vector_t_vec values = vector_t (Vec.to_list values)
+let set_t_vec values = set_t (Vec.to_list values)
+let map_t_vec fields = map_t (Vec.to_list fields)
+let list_vec values = any (list_t_vec values)
+let vector_vec values = any (vector_t_vec values)
+let set_vec values = any (set_t_vec values)
+let map_vec fields = any (map_t_vec fields)
+let map_t_rev_vec fields = map_t_vec (Vec.rev fields)
+let map_rev_vec fields = any (map_t_rev_vec fields)
+let vec_of_array = Rrbvec.of_array
+let keyword_text value = Melange_edn_melange.keyword_to_string value
+
+let int64_to_int_opt value =
+  let int_value = Int64.to_int value in
+  if Int64.of_int int_value = value then Some int_value else None
+
+let as_bool = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Bool value) -> Some value
+  | _ -> None
+
+let as_int = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Int value) ->
+      int64_to_int_opt value
+  | _ -> None
+
+let as_int64 = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Int value) -> Some value
+  | _ -> None
+
+let as_float = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Float value) -> Some value
+  | _ -> None
+
+let raw_string = function
+  | Melange_edn_melange.Any (Melange_edn_melange.String value) -> Some value
+  | _ -> None
+
+let as_string value =
+  Option.map
+    (fun value -> Ustring.(of_string value |> to_string))
+    (raw_string value)
+
+let as_symbol = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Symbol value) -> Some value
+  | _ -> None
+
+let as_keyword = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Keyword value) ->
+      Some (keyword_text value)
+  | _ -> None
+
+let as_keyword_t = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Keyword value) ->
+      Some (keyword_t (Melange_edn_melange.keyword_to_string value))
+  | _ -> None
+
+let as_uuid = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Tagged ("uuid", value)) ->
+      as_string value
+  | _ -> None
+
+let as_bytes = function
+  | Melange_edn_melange.Any
+      (Melange_edn_melange.Tagged ("transit/bytes", value)) ->
+      Option.map Bytes.of_string (raw_string value)
+  | _ -> None
+
+let as_list = function
+  | Melange_edn_melange.Any (Melange_edn_melange.List values) ->
+      Some (vec_of_array values)
+  | _ -> None
+
+let as_vector = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Vector values) ->
+      Some (vec_of_array values)
+  | _ -> None
+
+let as_vector_t = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Vector values) ->
+      Some (vector_t_vec (vec_of_array values))
+  | _ -> None
+
+let as_set = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Set values) ->
+      Some (vec_of_array values)
+  | _ -> None
+
+let as_map = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Map fields) ->
+      Some (vec_of_array fields)
+  | _ -> None
+
+let as_map_t = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Map fields) ->
+      Some (map_t_vec (vec_of_array fields))
+  | _ -> None
+
+let expect_vector_t label value =
+  match as_vector_t value with
+  | Some value -> value
+  | None -> invalid_arg (label ^ " must be an EDN vector")
+
+let expect_map_t label value =
+  match as_map_t value with
+  | Some value -> value
+  | None -> invalid_arg (label ^ " must be an EDN map")
+
+let is_null = function
+  | Melange_edn_melange.Any Melange_edn_melange.Nil -> true
+  | _ -> false
+
+let as_seq value =
+  match (as_list value, as_vector value, as_set value) with
+  | Some values, _, _ | _, Some values, _ | _, _, Some values -> Some values
+  | _ -> None
+
+let as_string_like value =
+  match (as_string value, as_keyword value, as_uuid value) with
+  | Some value, _, _ | _, Some value, _ | _, _, Some value -> Some value
+  | _ -> None
+
+let key_matches key field =
+  match (as_keyword field, as_string field) with
+  | Some value, _ | _, Some value -> value = key
+  | _ -> false
+
+let get value key =
+  match as_map value with
+  | Some fields ->
+      fields
+      |> Vec.find_map (fun (field, value) ->
+          if key_matches key field then Some value else None)
+  | None -> None
+
+let get_string value key = Option.bind (get value key) as_string_like
+let get_int value key = Option.bind (get value key) as_int
+let get_int64 value key = Option.bind (get value key) as_int64
+let get_bool value key = Option.bind (get value key) as_bool
+
+let assoc key value raw =
+  match as_map raw with
+  | Some fields ->
+      map_vec
+        (Vec.push_front
+           (Vec.filter (fun (field, _) -> not (key_matches key field)) fields)
+           (keyword key, value))
+  | None ->
+      map_vec (Vec.of_array [| (keyword key, value); (keyword "_", raw) |])
+
+let remove key raw =
+  match as_map raw with
+  | Some fields ->
+      map_vec
+        (fields |> Vec.filter (fun (field, _) -> not (key_matches key field)))
+  | None -> raw

cli/lib/entity.ml

@@ -0,0 +1,30 @@
+type kind = Page | Block | Tag | Property | Task | Asset | Unknown
+
+type t = {
+  id : Cli_primitive.db_id option;
+  uuid : Cli_primitive.uuid option;
+  ident : Cli_primitive.keyword option;
+  name : string option;
+  title : string option;
+  kind : kind;
+  tags : Cli_primitive.keyword Rrbvec.t;
+  created_at : Js.Date.t option;
+  updated_at : Js.Date.t option;
+  deleted_at : Js.Date.t option;
+  raw : Melange_edn_melange.any;
+}
+
+let of_value raw =
+  {
+    id = Edn_util.get_int64 raw "db/id";
+    uuid = Edn_util.get_string raw "block/uuid";
+    ident = Option.bind (Edn_util.get raw "db/ident") Edn_util.as_keyword_t;
+    name = Edn_util.get_string raw "name";
+    title = Edn_util.get_string raw "block/title";
+    kind = Unknown;
+    tags = Vec.empty;
+    created_at = None;
+    updated_at = None;
+    deleted_at = None;
+    raw;
+  }

cli/lib/error.ml

@@ -0,0 +1,306 @@
+type code =
+  | Add_id_resolution_failed
+  | Agent_bridge_already_running
+  | Agent_bridge_lock_failed
+  | Agent_master_prompt_invalid
+  | Agent_name_invalid
+  | Agent_prompt_template_invalid
+  | Ambiguous_page_name
+  | Ambiguous_property_name
+  | Ambiguous_tag_name
+  | Asset_checksum_failed
+  | Asset_checksum_missing
+  | Asset_create_failed
+  | Asset_file_copy_failed
+  | Asset_file_not_found
+  | Asset_not_found
+  | Asset_not_remote
+  | Asset_tag_not_found
+  | Asset_type_missing
+  | Asset_uuid_missing
+  | Auth_code_exchange_failed
+  | Auth_file_delete_failed
+  | Auth_file_write_failed
+  | Auth_refresh_failed
+  | Backup_create_failed
+  | Backup_not_found
+  | Block_link_cycle
+  | Block_link_target_not_found
+  | Block_not_found
+  | Browser_open_failed
+  | Codex_not_found
+  | Codex_session_id_missing
+  | Codex_start_failed
+  | Config_write_failed
+  | Doctor_error
+  | Doctor_script_missing
+  | Doctor_script_unreadable
+  | Doctor_server_not_ready
+  | E2ee_password_failed
+  | E2ee_password_not_found
+  | Entity_not_found
+  | Exception
+  | External_asset
+  | Graph_already_exists
+  | Graph_db_not_empty
+  | Graph_exists
+  | Graph_not_exists
+  | Graph_not_removed
+  | Graph_validation_failed
+  | Invalid_auth_file
+  | Invalid_auth_token
+  | Invalid_blocks
+  | Invalid_callback_request
+  | Invalid_callback_state
+  | Invalid_config
+  | Invalid_options
+  | Invalid_property_target
+  | Invalid_query
+  | Invalid_source
+  | Invalid_tag_target
+  | Invalid_target
+  | Login_callback_error
+  | Login_callback_not_found
+  | Login_callback_server_start_failed
+  | Login_not_configured
+  | Login_timeout
+  | Logout_not_configured
+  | Missing_asset_selector
+  | Missing_auth
+  | Missing_callback_code
+  | Missing_content
+  | Missing_dst
+  | Missing_examples
+  | Missing_graph
+  | Missing_id_token
+  | Missing_page_name
+  | Missing_property_name
+  | Missing_query
+  | Missing_query_text
+  | Missing_repo
+  | Missing_snapshot
+  | Missing_source
+  | Missing_tag_name
+  | Missing_target
+  | Missing_template_code_block
+  | Missing_template_vars
+  | Not_asset
+  | Not_implemented
+  | Page_hierarchy_parent_cycle
+  | Page_not_found
+  | Property_built_in
+  | Property_hidden
+  | Property_not_found
+  | Recycled_page
+  | Remote_graph_not_found
+  | Root_dir_permission
+  | Server_cleanup_failed
+  | Server_not_found
+  | Server_owned_by_other
+  | Server_revision_mismatch_after_restart
+  | Server_script_missing
+  | Server_start_failed
+  | Server_start_timeout_orphan
+  | Server_stop_timeout
+  | Skill_home_dir_unavailable
+  | Skill_install_failed
+  | Skill_show_failed
+  | Skill_source_not_found
+  | Source_not_found
+  | Spec_blocker
+  | Sync_not_started
+  | Sync_remote_graphs_failed
+  | Sync_start_runtime_error
+  | Sync_start_timeout
+  | Sync_upload_failed
+  | Tag_built_in
+  | Tag_create_not_tag
+  | Tag_hidden
+  | Tag_name_conflict
+  | Tag_not_found
+  | Tag_rename_conflict
+  | Target_not_found
+  | Task_tag_not_found
+  | Unknown_command
+  | Unknown_query
+  | Unknown_template_vars
+  | Unsupported_input_format
+  | Unsupported_output_format
+  | Upsert_id_not_found
+  | Upsert_id_type_mismatch
+
+type candidate = { id : Cli_primitive.db_id option; name : string option }
+
+type t = {
+  code : code;
+  message : string;
+  hint : string option;
+  candidates : candidate Rrbvec.t;
+  context : Melange_edn_melange.any option;
+}
+
+type 'a build_result = ('a, t) result
+
+type source =
+  | Cli_parse
+  | Config
+  | Build_action
+  | Transport
+  | Server
+  | Auth
+  | Sync
+  | Db_worker
+  | Filesystem
+  | Unknown
+
+let code_to_string = function
+  | Add_id_resolution_failed -> "add-id-resolution-failed"
+  | Agent_bridge_already_running -> "agent-bridge-already-running"
+  | Agent_bridge_lock_failed -> "agent-bridge-lock-failed"
+  | Agent_master_prompt_invalid -> "agent-master-prompt-invalid"
+  | Agent_name_invalid -> "agent-name-invalid"
+  | Agent_prompt_template_invalid -> "agent-prompt-template-invalid"
+  | Ambiguous_page_name -> "ambiguous-page-name"
+  | Ambiguous_property_name -> "ambiguous-property-name"
+  | Ambiguous_tag_name -> "ambiguous-tag-name"
+  | Asset_checksum_failed -> "asset-checksum-failed"
+  | Asset_checksum_missing -> "asset-checksum-missing"
+  | Asset_create_failed -> "asset-create-failed"
+  | Asset_file_copy_failed -> "asset-file-copy-failed"
+  | Asset_file_not_found -> "asset-file-not-found"
+  | Asset_not_found -> "asset-not-found"
+  | Asset_not_remote -> "asset-not-remote"
+  | Asset_tag_not_found -> "asset-tag-not-found"
+  | Asset_type_missing -> "asset-type-missing"
+  | Asset_uuid_missing -> "asset-uuid-missing"
+  | Auth_code_exchange_failed -> "auth-code-exchange-failed"
+  | Auth_file_delete_failed -> "auth-file-delete-failed"
+  | Auth_file_write_failed -> "auth-file-write-failed"
+  | Auth_refresh_failed -> "auth-refresh-failed"
+  | Backup_create_failed -> "backup-create-failed"
+  | Backup_not_found -> "backup-not-found"
+  | Block_link_cycle -> "block-link-cycle"
+  | Block_link_target_not_found -> "block-link-target-not-found"
+  | Block_not_found -> "block-not-found"
+  | Browser_open_failed -> "browser-open-failed"
+  | Codex_not_found -> "codex-not-found"
+  | Codex_session_id_missing -> "codex-session-id-missing"
+  | Codex_start_failed -> "codex-start-failed"
+  | Config_write_failed -> "config-write-failed"
+  | Doctor_error -> "doctor-error"
+  | Doctor_script_missing -> "doctor-script-missing"
+  | Doctor_script_unreadable -> "doctor-script-unreadable"
+  | Doctor_server_not_ready -> "doctor-server-not-ready"
+  | E2ee_password_failed -> "e2ee-password-failed"
+  | E2ee_password_not_found -> "e2ee-password-not-found"
+  | Entity_not_found -> "entity-not-found"
+  | Exception -> "exception"
+  | External_asset -> "external-asset"
+  | Graph_already_exists -> "graph-already-exists"
+  | Graph_db_not_empty -> "graph-db-not-empty"
+  | Graph_exists -> "graph-exists"
+  | Graph_not_exists -> "graph-not-exists"
+  | Graph_not_removed -> "graph-not-removed"
+  | Graph_validation_failed -> "graph-validation-failed"
+  | Invalid_auth_file -> "invalid-auth-file"
+  | Invalid_auth_token -> "invalid-auth-token"
+  | Invalid_blocks -> "invalid-blocks"
+  | Invalid_callback_request -> "invalid-callback-request"
+  | Invalid_callback_state -> "invalid-callback-state"
+  | Invalid_config -> "invalid-config"
+  | Invalid_options -> "invalid-options"
+  | Invalid_property_target -> "invalid-property-target"
+  | Invalid_query -> "invalid-query"
+  | Invalid_source -> "invalid-source"
+  | Invalid_tag_target -> "invalid-tag-target"
+  | Invalid_target -> "invalid-target"
+  | Login_callback_error -> "login-callback-error"
+  | Login_callback_not_found -> "login-callback-not-found"
+  | Login_callback_server_start_failed -> "login-callback-server-start-failed"
+  | Login_not_configured -> "login-not-configured"
+  | Login_timeout -> "login-timeout"
+  | Logout_not_configured -> "logout-not-configured"
+  | Missing_asset_selector -> "missing-asset-selector"
+  | Missing_auth -> "missing-auth"
+  | Missing_callback_code -> "missing-callback-code"
+  | Missing_content -> "missing-content"
+  | Missing_dst -> "missing-dst"
+  | Missing_examples -> "missing-examples"
+  | Missing_graph -> "missing-graph"
+  | Missing_id_token -> "missing-id-token"
+  | Missing_page_name -> "missing-page-name"
+  | Missing_property_name -> "missing-property-name"
+  | Missing_query -> "missing-query"
+  | Missing_query_text -> "missing-query-text"
+  | Missing_repo -> "missing-repo"
+  | Missing_snapshot -> "missing-snapshot"
+  | Missing_source -> "missing-source"
+  | Missing_tag_name -> "missing-tag-name"
+  | Missing_target -> "missing-target"
+  | Missing_template_code_block -> "missing-template-code-block"
+  | Missing_template_vars -> "missing-template-vars"
+  | Not_asset -> "not-asset"
+  | Not_implemented -> "not-implemented"
+  | Page_hierarchy_parent_cycle -> "page-hierarchy-parent-cycle"
+  | Page_not_found -> "page-not-found"
+  | Property_built_in -> "property-built-in"
+  | Property_hidden -> "property-hidden"
+  | Property_not_found -> "property-not-found"
+  | Recycled_page -> "recycled-page"
+  | Remote_graph_not_found -> "remote-graph-not-found"
+  | Root_dir_permission -> "root-dir-permission"
+  | Server_cleanup_failed -> "server-cleanup-failed"
+  | Server_not_found -> "server-not-found"
+  | Server_owned_by_other -> "server-owned-by-other"
+  | Server_revision_mismatch_after_restart ->
+      "server-revision-mismatch-after-restart"
+  | Server_script_missing -> "server-script-missing"
+  | Server_start_failed -> "server-start-failed"
+  | Server_start_timeout_orphan -> "server-start-timeout-orphan"
+  | Server_stop_timeout -> "server-stop-timeout"
+  | Skill_home_dir_unavailable -> "skill-home-dir-unavailable"
+  | Skill_install_failed -> "skill-install-failed"
+  | Skill_show_failed -> "skill-show-failed"
+  | Skill_source_not_found -> "skill-source-not-found"
+  | Source_not_found -> "source-not-found"
+  | Spec_blocker -> "spec-blocker"
+  | Sync_not_started -> "sync-not-started"
+  | Sync_remote_graphs_failed -> "sync-remote-graphs-failed"
+  | Sync_start_runtime_error -> "sync-start-runtime-error"
+  | Sync_start_timeout -> "sync-start-timeout"
+  | Sync_upload_failed -> "sync-upload-failed"
+  | Tag_built_in -> "tag-built-in"
+  | Tag_create_not_tag -> "tag-create-not-tag"
+  | Tag_hidden -> "tag-hidden"
+  | Tag_name_conflict -> "tag-name-conflict"
+  | Tag_not_found -> "tag-not-found"
+  | Tag_rename_conflict -> "tag-rename-conflict"
+  | Target_not_found -> "target-not-found"
+  | Task_tag_not_found -> "task-tag-not-found"
+  | Unknown_command -> "unknown-command"
+  | Unknown_query -> "unknown-query"
+  | Unknown_template_vars -> "unknown-template-vars"
+  | Unsupported_input_format -> "unsupported-input-format"
+  | Unsupported_output_format -> "unsupported-output-format"
+  | Upsert_id_not_found -> "upsert-id-not-found"
+  | Upsert_id_type_mismatch -> "upsert-id-type-mismatch"
+
+let code_to_keyword code = Edn_util.keyword_t (code_to_string code)
+
+let make ?hint ?(candidates = Vec.empty) ?context code message =
+  { code; message; hint; candidates; context }
+
+let invalid_options message = make Invalid_options message
+
+let missing_graph () =
+  make ~hint:"Use --graph <name>" Missing_graph "graph name is required"
+
+let missing_repo message = make Missing_repo message
+let missing_target message = make Missing_target message
+let unknown_command message = make Unknown_command message
+
+let exception_error ?context exn =
+  make ?context Exception (Printexc.to_string exn)
+
+let map f = function Ok x -> Ok (f x) | Error e -> Error e
+let bind x f = match x with Ok v -> f v | Error e -> Error e

cli/lib/example.ml

@@ -0,0 +1,391 @@
+type opts = { selector : string Rrbvec.t }
+type parsed = Parsed_example of opts
+
+type action = {
+  selector : string;
+  selector_path : string Rrbvec.t;
+  matched_commands : string Rrbvec.t;
+  examples : string Rrbvec.t;
+  message : string;
+}
+
+type entry = { path : string Rrbvec.t; examples : string Rrbvec.t }
+
+let entry path examples =
+  { path = Vec.of_array path; examples = Vec.of_array examples }
+
+let default_entries =
+  Vec.of_array
+    [|
+      entry [| "graph"; "list" |] [| "logseq graph list" |];
+      entry [| "graph"; "create" |]
+        [|
+          "logseq graph create --graph my-graph";
+          "logseq graph create --graph my-graph --enable-sync";
+          "logseq graph create --graph my-graph --enable-sync --e2ee-password \
+           \"my-secret\"";
+        |];
+      entry [| "graph"; "switch" |] [| "logseq graph switch --graph my-graph" |];
+      entry [| "graph"; "remove" |] [| "logseq graph remove --graph my-graph" |];
+      entry [| "graph"; "validate" |]
+        [|
+          "logseq graph validate --graph my-graph";
+          "logseq graph validate --graph my-graph --fix";
+        |];
+      entry [| "graph"; "info" |] [| "logseq graph info --graph my-graph" |];
+      entry [| "graph"; "export" |]
+        [|
+          "logseq graph export --graph my-graph --type edn --file \
+           /tmp/my-graph.edn --edn-options '{:export-type :graph \
+           :include-timestamps? true}' --pretty-print";
+          "logseq graph export --graph my-graph --type sqlite --file \
+           /tmp/my-graph.sqlite";
+        |];
+      entry [| "graph"; "import" |]
+        [|
+          "logseq graph import --graph my-graph --type edn --input \
+           /tmp/my-graph.edn";
+        |];
+      entry
+        [| "graph"; "backup"; "list" |]
+        [| "logseq graph backup list --graph my-graph" |];
+      entry
+        [| "graph"; "backup"; "create" |]
+        [|
+          "logseq graph backup create --graph my-graph";
+          "logseq graph backup create --graph my-graph --name nightly";
+        |];
+      entry
+        [| "graph"; "backup"; "restore" |]
+        [|
+          "logseq graph backup restore --src my-graph-nightly --dst \
+           my-graph-restore";
+        |];
+      entry
+        [| "graph"; "backup"; "remove" |]
+        [| "logseq graph backup remove --src my-graph-nightly" |];
+      entry [| "list"; "page" |]
+        [|
+          "logseq list page --graph my-graph";
+          "logseq list page --graph my-graph --journal-only --limit 20";
+          "logseq list page --graph my-graph --limit 50 --sort updated-at \
+           --order desc";
+        |];
+      entry [| "list"; "tag" |]
+        [|
+          "logseq list tag --graph my-graph --with-properties";
+          "logseq list tag --graph my-graph --include-built-in --limit 20 \
+           --output json";
+        |];
+      entry [| "list"; "property" |]
+        [|
+          "logseq list property --graph my-graph --with-type";
+          "logseq list property --graph my-graph --include-built-in --limit 20 \
+           --output json";
+        |];
+      entry [| "list"; "task" |]
+        [|
+          "logseq list task --graph my-graph --status todo --priority high";
+          "logseq list task --graph my-graph --content \"release\" --sort \
+           updated-at --order desc";
+        |];
+      entry [| "list"; "node" |]
+        [|
+          "logseq list node --graph my-graph --tags project,work";
+          "logseq list node --graph my-graph --properties status,priority \
+           --sort updated-at --order desc";
+        |];
+      entry [| "list"; "asset" |]
+        [|
+          "logseq list asset --graph my-graph";
+          "logseq list asset --graph my-graph --limit 20 --sort updated-at \
+           --order desc";
+        |];
+      entry [| "upsert"; "block" |]
+        [|
+          "logseq upsert block --graph my-graph --target-page Home --content \
+           \"New block\"";
+          "logseq upsert block --graph my-graph --id 123 --content \"Updated \
+           content\"";
+          "logseq upsert block --graph my-graph --id 123 --target-page Home";
+          "logseq upsert block --graph my-graph --target-page Meeting Notes \
+           --content \"AI summary of the discussion\" --update-tags \
+           '[\"AI-GENERATED\"]'";
+          "logseq upsert block --graph my-graph --blocks '[{:block/title \
+           \"A\"} {:block/title \"B\"}]'";
+        |];
+      entry [| "upsert"; "page" |]
+        [|
+          "logseq upsert page --graph my-graph --page Home --update-tags \
+           '[\"project\"]'";
+          "logseq upsert page --graph my-graph --id 999 --update-properties \
+           '{:logseq.property/description \"Example\"}'";
+        |];
+      entry [| "upsert"; "task" |]
+        [|
+          "logseq upsert task --graph my-graph --content \"Ship release\" \
+           --target-page Home --status todo --priority high --scheduled \
+           \"2026-02-10T08:00:00.000Z\" --deadline \
+           \"2026-02-12T18:00:00.000Z\"";
+          "logseq upsert task --graph my-graph --page Weekly Plan --status \
+           doing";
+          "logseq upsert task --graph my-graph --id 123 --no-status \
+           --no-priority";
+        |];
+      entry [| "upsert"; "asset" |]
+        [|
+          "logseq upsert asset --graph my-graph --path ./assets/logo.png \
+           --target-page Home";
+          "logseq upsert asset --graph my-graph --id 123 --content \"Updated \
+           asset title\"";
+        |];
+      entry [| "upsert"; "tag" |]
+        [|
+          "logseq upsert tag --graph my-graph --name project";
+          "logseq upsert tag --graph my-graph --id 200 --name Project Renamed";
+          "logseq upsert tag --graph my-graph --name project --add-properties \
+           '[\"status\" \"owner\"]'";
+        |];
+      entry [| "upsert"; "property" |]
+        [|
+          "logseq upsert property --graph my-graph --name status --type \
+           default --cardinality one";
+          "logseq upsert property --graph my-graph --id 321 --hide true";
+        |];
+      entry [| "remove"; "block" |]
+        [|
+          "logseq remove block --graph my-graph --id 123";
+          "logseq remove block --graph my-graph --id '[123,456]'";
+          "logseq remove block --graph my-graph --uuid \
+           7f0f4bb3-2e48-4b46-ae0f-18f52ef0f8be";
+        |];
+      entry [| "remove"; "page" |]
+        [|
+          "logseq remove page --graph my-graph --page Home";
+          "logseq remove page --graph my-graph --id 123";
+        |];
+      entry [| "remove"; "tag" |]
+        [| "logseq remove tag --graph my-graph --name project" |];
+      entry [| "remove"; "property" |]
+        [|
+          "logseq remove property --graph my-graph --name owner";
+          "logseq remove property --graph my-graph --id 321";
+        |];
+      entry [| "query" |]
+        [|
+          "logseq query --graph my-graph --name recent-updated --inputs '[30]'";
+          "logseq query --graph my-graph --name task-search --inputs \
+           '[:logseq.property/status.done \"daily\"]'";
+          "logseq query --graph my-graph --query '[:find [?e ...] :where [?e \
+           :block/name]]'";
+        |];
+      entry [| "query"; "list" |]
+        [|
+          "logseq query list --graph my-graph";
+          "logseq query list --graph my-graph --output edn";
+        |];
+      entry [| "search"; "block" |]
+        [| "logseq search block --content \"task\" --graph my-graph" |];
+      entry [| "search"; "page" |]
+        [| "logseq search page --content \"home\" --graph my-graph" |];
+      entry [| "search"; "property" |]
+        [| "logseq search property --content \"owner\" --graph my-graph" |];
+      entry [| "search"; "tag" |]
+        [| "logseq search tag --content \"quote\" --graph my-graph" |];
+      entry [| "show" |]
+        [|
+          "logseq show --graph my-graph --page Home";
+          "logseq show --graph my-graph --page Foo --page-hierarchy true";
+          "logseq show --graph my-graph --page \"Meeting Notes\" --level 2";
+          "logseq show --graph my-graph --id 123 --level 3";
+          "logseq show --graph my-graph --id '[123,456,789]'";
+          "logseq show --graph my-graph --uuid \
+           11111111-1111-1111-1111-111111111111";
+        |];
+      entry [| "server"; "list" |] [| "logseq server list" |];
+      entry [| "server"; "cleanup" |] [| "logseq server cleanup" |];
+      entry [| "server"; "start" |] [| "logseq server start --graph my-graph" |];
+      entry [| "server"; "stop" |] [| "logseq server stop --graph my-graph" |];
+      entry [| "server"; "restart" |]
+        [| "logseq server restart --graph my-graph" |];
+      entry [| "sync"; "status" |] [| "logseq sync status --graph my-graph" |];
+      entry [| "sync"; "start" |]
+        [|
+          "logseq sync start --graph my-graph";
+          "logseq sync start --graph my-graph --e2ee-password \"my-secret\"";
+        |];
+      entry [| "sync"; "stop" |] [| "logseq sync stop --graph my-graph" |];
+      entry [| "sync"; "upload" |]
+        [|
+          "logseq sync upload --graph my-graph";
+          "logseq sync upload --graph my-graph --e2ee-password \"my-secret\"";
+        |];
+      entry [| "sync"; "download" |]
+        [|
+          "logseq sync download --graph my-graph";
+          "logseq sync download --graph my-graph --progress";
+          "logseq sync download --graph my-graph --e2ee-password \"my-secret\"";
+        |];
+      entry
+        [| "sync"; "asset"; "download" |]
+        [|
+          "logseq sync asset download --graph my-graph --id 123";
+          "logseq sync asset download --graph my-graph --uuid <asset-uuid>";
+        |];
+      entry [| "sync"; "remote-graphs" |] [| "logseq sync remote-graphs" |];
+      entry
+        [| "sync"; "ensure-keys" |]
+        [|
+          "logseq sync ensure-keys";
+          "logseq sync ensure-keys --e2ee-password \"my-secret\" --upload-keys";
+        |];
+      entry
+        [| "sync"; "grant-access" |]
+        [|
+          "logseq sync grant-access --graph my-graph --graph-id \
+           8b6ecdd0-1fab-4a9f-b3fb-3069c5f76e95 --email teammate@example.com";
+        |];
+      entry
+        [| "sync"; "config"; "set" |]
+        [| "logseq sync config set sync-enabled true" |];
+      entry
+        [| "sync"; "config"; "get" |]
+        [| "logseq sync config get sync-enabled" |];
+      entry
+        [| "sync"; "config"; "unset" |]
+        [| "logseq sync config unset sync-enabled" |];
+    |]
+
+let example_groups =
+  Vec.of_array
+    [|
+      "graph";
+      "list";
+      "upsert";
+      "remove";
+      "query";
+      "search";
+      "show";
+      "server";
+      "sync";
+    |]
+
+let label path = Vec.string_concat " " path
+let command_id _ = Command_id.Example
+let validate_parsed _ = Ok ()
+
+let registry_entries registry =
+  registry.Command_registry.commands
+  |> Vec.filter_map (fun (meta : Command_registry.command_meta) ->
+      match Vec.nth_opt meta.path 0 with
+      | Some group when Vec.mem group example_groups ->
+          Some { path = meta.path; examples = meta.examples }
+      | _ -> None)
+
+let entries_for registry =
+  let entries = registry_entries registry in
+  if Vec.is_empty entries then default_entries else entries
+
+let matching_entries entries selector =
+  if Vec.is_empty selector then
+    Vec.filter (fun entry -> not (Vec.is_empty entry.examples)) entries
+  else if Vec.length selector = 1 then
+    let group = Vec.nth selector 0 in
+    Vec.filter
+      (fun entry ->
+        match Vec.nth_opt entry.path 0 with
+        | Some first -> first = group
+        | None -> false)
+      entries
+  else
+    Vec.filter (fun entry -> Vec.equal String.equal entry.path selector) entries
+
+let resolve_selector registry selector =
+  match selector with
+  | _ ->
+      let entries = entries_for registry in
+      let matches = matching_entries entries selector in
+      let selector_label =
+        if Vec.is_empty selector then "all" else label selector
+      in
+      if Vec.is_empty matches then
+        Error
+          (Error.unknown_command
+             ("unknown example selector: " ^ selector_label))
+      else
+        let missing =
+          matches
+          |> Vec.filter (fun entry -> Vec.is_empty entry.examples)
+          |> Vec.map (fun entry -> label entry.path)
+        in
+        if not (Vec.is_empty missing) then
+          Error
+            (Error.make Error.Missing_examples
+               ("missing examples metadata for: "
+               ^ Vec.string_concat ", " missing))
+        else
+          let matched_commands =
+            Vec.map (fun entry -> label entry.path) matches
+          in
+          let examples = Vec.concat_map (fun entry -> entry.examples) matches in
+          let count = Vec.length examples in
+          Ok
+            {
+              selector = selector_label;
+              selector_path = selector;
+              matched_commands;
+              examples;
+              message =
+                "Found "
+                ^ Humanize_types.format_count count
+                ^ " "
+                ^ Humanize_types.pluralize_noun count "example"
+                ^ " for selector " ^ selector_label;
+            }
+
+let build ?registry _ _ = function
+  | Parsed_example { selector } ->
+      resolve_selector
+        (Option.value registry ~default:Command_registry.empty)
+        selector
+
+let value_of_action action =
+  Edn_util.map_vec
+    (Vec.of_array
+       [|
+         (Edn_util.keyword "selector", Edn_util.string action.selector);
+         ( Edn_util.keyword "matched-commands",
+           Edn_util.vector_vec
+             (action.matched_commands
+             |> Vec.map (fun command -> Edn_util.string command)) );
+         ( Edn_util.keyword "examples",
+           Edn_util.vector_vec
+             (action.examples
+             |> Vec.map (fun example -> Edn_util.string example)) );
+         (Edn_util.keyword "message", Edn_util.string action.message);
+       |])
+
+let execute_with_mode action _config mode =
+  Cli_effect.pure
+    (Cli_result.ok ~command:Command_id.Example mode
+       (Raw (value_of_action action)))
+
+let metadata () =
+  Vec.singleton
+    {
+      Command_registry.id = Command_id.Example;
+      path = Command_id.to_path Command_id.Example;
+      doc = "Show runnable command examples";
+      long_doc = None;
+      examples = Vec.empty;
+      options = Vec.empty;
+      category = Command_registry.Utilities;
+      requires_graph = Command_id.requires_graph Command_id.Example;
+      requires_auth = Command_id.requires_auth Command_id.Example;
+      write_command = Command_id.is_write Command_id.Example;
+      human_table_headers_order = Vec.empty;
+    }
+
+let execute action config =
+  let (Output.Mode.Packed mode) = Output_mode.for_config config in
+  execute_with_mode action config mode

cli/lib/format_types.ml

@@ -0,0 +1,445 @@
+type formatter = Cli_result.t -> Cli_config.t -> string
+
+let normalize_json v = v
+
+let strip_leading_colon value =
+  if String.length value > 0 && value.[0] = ':' then
+    String.sub value 1 (String.length value - 1)
+  else value
+
+let unquote_transit_value = function
+  | Melange_edn_melange.Any
+      (Melange_edn_melange.Tagged (("transit/quote" | "'"), value)) ->
+      value
+  | value -> value
+
+let rec json_of_value value =
+  let value = unquote_transit_value value in
+  match
+    ( Edn_util.is_null value,
+      Edn_util.as_bool value,
+      Edn_util.as_int value,
+      Edn_util.as_float value,
+      Edn_util.as_string_like value,
+      Edn_util.as_bytes value,
+      Edn_util.as_seq value,
+      Edn_util.as_map value )
+  with
+  | true, _, _, _, _, _, _, _ -> Js.Json.null
+  | _, Some b, _, _, _, _, _, _ -> Js.Json.boolean b
+  | _, _, Some i, _, _, _, _, _ -> Js.Json.number (float_of_int i)
+  | _, _, _, Some f, _, _, _, _ -> Js.Json.number f
+  | _, _, _, _, Some s, _, _, _ -> Js.Json.string (strip_leading_colon s)
+  | _, _, _, _, _, Some b, _, _ -> Js.Json.string (Bytes.to_string b)
+  | _, _, _, _, _, _, Some xs, _ ->
+      Js.Json.array (xs |> Vec.map json_of_value |> Vec.to_array)
+  | _, _, _, _, _, _, _, Some xs ->
+      let object_ = Js.Dict.empty () in
+      Vec.iter
+        (fun (k, v) ->
+          let key =
+            match Edn_util.as_string_like k with
+            | Some s -> strip_leading_colon s
+            | None -> Melange_edn_melange.to_edn_string k
+          in
+          Js.Dict.set object_ key (json_of_value v))
+        xs;
+      Js.Json.object_ object_
+  | _ -> Melange_edn_melange.to_json value
+
+let data_to_value = function
+  | Cli_result.Message s ->
+      Edn_util.map_vec
+        (Vec.of_array [| (Edn_util.keyword "message", Edn_util.string s) |])
+  | Items xs -> Edn_util.vector_vec xs
+  | Entity v | Query_result v | Raw v -> v
+  | Empty -> Edn_util.nil
+
+let contains_substring ~needle text =
+  let needle_len = String.length needle in
+  let text_len = String.length text in
+  let rec loop index =
+    index + needle_len <= text_len
+    && (String.sub text index needle_len = needle || loop (index + 1))
+  in
+  loop 0
+
+let sensitive_field key =
+  let key = String.lowercase_ascii (strip_leading_colon key) in
+  Vec.exists
+    (fun needle -> contains_substring ~needle key)
+    (Vec.of_array [| "token"; "secret"; "password" |])
+
+let rec redact_sensitive_value value =
+  match Edn_util.as_map value with
+  | Some fields ->
+      fields
+      |> Vec.map (fun (key, value) ->
+          let value =
+            match Edn_util.as_string_like key with
+            | Some key when sensitive_field key -> Edn_util.string "[REDACTED]"
+            | _ -> redact_sensitive_value value
+          in
+          (key, value))
+      |> Edn_util.map_vec
+  | None -> (
+      match Edn_util.as_seq value with
+      | Some values ->
+          Edn_util.vector_vec (values |> Vec.map redact_sensitive_value)
+      | None -> value)
+
+let result_data_value result =
+  let data =
+    match result.Cli_result.data with
+    | Some data -> data_to_value data
+    | None -> Edn_util.nil
+  in
+  match result.Cli_result.command with
+  | Some Command_id.Graph_info -> redact_sensitive_value data
+  | _ -> data
+
+let candidate_to_value (candidate : Error.candidate) =
+  let fields =
+    match candidate.name with
+    | Some name -> Vec.singleton (Edn_util.keyword "name", Edn_util.string name)
+    | None -> Vec.empty
+  in
+  let fields =
+    match candidate.id with
+    | Some id -> Vec.push_front fields (Edn_util.keyword "id", Edn_util.int64 id)
+    | None -> fields
+  in
+  Edn_util.map_vec fields
+
+let error_to_value ?(edn = false) (error : Error.t) =
+  let code_value =
+    if edn then Edn_util.any (Error.code_to_keyword error.code)
+    else Edn_util.string (Error.code_to_string error.code)
+  in
+  let fields =
+    Vec.of_array
+      [|
+        (Edn_util.keyword "code", code_value);
+        (Edn_util.keyword "message", Edn_util.string error.message);
+      |]
+  in
+  let fields =
+    match error.hint with
+    | None -> fields
+    | Some hint ->
+        Vec.push_back fields (Edn_util.keyword "hint", Edn_util.string hint)
+  in
+  let fields =
+    if Vec.is_empty error.candidates then fields
+    else
+      let candidates = error.candidates in
+      Vec.push_back fields
+        ( Edn_util.keyword "candidates",
+          Edn_util.vector_vec (candidates |> Vec.map candidate_to_value) )
+  in
+  let fields =
+    match error.context with
+    | None -> fields
+    | Some context -> (
+        match Edn_util.as_map context with
+        | Some context_fields ->
+            let reserved =
+              Vec.of_array [| "code"; "message"; "hint"; "candidates" |]
+            in
+            Vec.append fields
+              (context_fields
+              |> Vec.filter (fun (key, _) ->
+                  match Edn_util.as_string_like key with
+                  | Some key -> not (Vec.mem (strip_leading_colon key) reserved)
+                  | None -> true))
+        | None -> Vec.push_back fields (Edn_util.keyword "context", context))
+  in
+  Edn_util.map_vec fields
+
+let to_json result =
+  let object_ = Js.Dict.empty () in
+  match result.Cli_result.status with
+  | Ok ->
+      let data = result_data_value result in
+      Js.Dict.set object_ "status" (Js.Json.string "ok");
+      Js.Dict.set object_ "data" (json_of_value data);
+      Js.Json.stringify (Js.Json.object_ object_)
+  | Error ->
+      let error =
+        match result.error with
+        | Some e -> error_to_value e
+        | None -> Edn_util.map_vec Vec.empty
+      in
+      Js.Dict.set object_ "status" (Js.Json.string "error");
+      Js.Dict.set object_ "error" (json_of_value error);
+      Js.Json.stringify (Js.Json.object_ object_)
+
+let to_edn result =
+  let status, payload_key, payload =
+    match result.Cli_result.status with
+    | Ok ->
+        let data = result_data_value result in
+        (Edn_util.keyword "ok", Edn_util.keyword "data", data)
+    | Error ->
+        let error =
+          match result.error with
+          | Some e -> error_to_value ~edn:true e
+          | None -> Edn_util.map_vec Vec.empty
+        in
+        (Edn_util.keyword "error", Edn_util.keyword "error", error)
+  in
+  Melange_edn_melange.to_edn_string
+    (Edn_util.map_vec
+       (Vec.of_array
+          [| (Edn_util.keyword "status", status); (payload_key, payload) |]))
+
+let render_human table = Output.Human_output.to_string table
+let count_footer count = "Count: " ^ Humanize_types.format_count count
+
+let field_label key =
+  key |> Edn_util.as_string_like
+  |> Option.value ~default:(Melange_edn_melange.to_edn_string key)
+  |> strip_leading_colon
+
+let value_text value =
+  let value = unquote_transit_value value in
+  match
+    ( Edn_util.is_null value,
+      Edn_util.as_string_like value,
+      Edn_util.as_int value,
+      Edn_util.as_bool value,
+      Edn_util.as_float value )
+  with
+  | true, _, _, _, _ -> ""
+  | _, Some value, _, _, _ -> strip_leading_colon value
+  | _, _, Some value, _, _ -> string_of_int value
+  | _, _, _, Some value, _ -> string_of_bool value
+  | _, _, _, _, Some value -> string_of_float value
+  | _ -> Melange_edn_melange.to_edn_string value
+
+let query_result_human value =
+  match Edn_util.get value "result" with
+  | Some result -> (
+      match Edn_util.as_seq result with
+      | Some values -> values |> Vec.map value_text |> Vec.string_concat "\n"
+      | None -> value_text result)
+  | None -> value_text value
+
+let is_keyword_namespace_char = function
+  | 'a' .. 'z' | '0' .. '9' | '.' | '-' | '_' -> true
+  | _ -> false
+
+let is_keyword_namespace value =
+  value <> "" && String.for_all is_keyword_namespace_char value
+
+let human_header_label label =
+  let label = strip_leading_colon label in
+  let parts = Vec.split_on_char '/' label in
+  if Vec.length parts = 2 then
+    let namespace = Vec.nth parts 0 in
+    let name = Vec.nth parts 1 in
+    if is_keyword_namespace namespace && name <> "" then name else label
+  else label
+
+let add_column acc label =
+  if Vec.mem label acc then acc else Vec.push_back acc label
+
+let discovered_table_columns items =
+  items
+  |> Vec.fold_left
+       (fun acc fields ->
+         fields
+         |> Vec.map (fun (key, _) -> field_label key)
+         |> Vec.fold_left add_column acc)
+       Vec.empty
+
+let order_table_columns header_order columns =
+  let ordered =
+    header_order
+    |> Vec.filter_map (fun expected ->
+        Vec.find_opt
+          (fun label -> label = expected || human_header_label label = expected)
+          columns)
+  in
+  let ordered =
+    Vec.fold_left
+      (fun acc label ->
+        if Vec.mem label acc then acc else Vec.push_back acc label)
+      Vec.empty ordered
+  in
+  ordered
+
+let field_by_label label fields =
+  fields
+  |> Vec.find_map (fun (key, value) ->
+      if field_label key = label then Some value else None)
+
+let is_title_label label =
+  match String.lowercase_ascii label with
+  | "title" | "block/title" -> true
+  | _ -> false
+
+let title_max_display_width config =
+  if config.Cli_config.list_title_max_display_width > 0 then
+    config.list_title_max_display_width
+  else (Cli_config.defaults ()).list_title_max_display_width
+
+let truncate_title_cell max_width value =
+  let first_line = Vec.split_on_char '\n' value |> Vec.peek_front in
+  Display_width.truncate first_line max_width
+
+let is_list_command = function
+  | Command_id.List_page | List_tag | List_property | List_task | List_node
+  | List_asset ->
+      true
+  | _ -> false
+
+let is_search_command = function
+  | Command_id.Search_block | Search_page | Search_property | Search_tag -> true
+  | _ -> false
+
+let is_list_or_search_command command =
+  is_list_command command || is_search_command command
+
+let table_columns ~human_table_headers_order items =
+  discovered_table_columns items
+  |> order_table_columns human_table_headers_order
+
+let should_truncate_title command label =
+  is_list_command command && is_title_label label
+
+let is_task_keyword_value_label label =
+  match human_header_label label with
+  | "status" | "priority" -> true
+  | _ -> false
+
+let list_cell_value_text command label value =
+  let value = unquote_transit_value value in
+  match command with
+  | Command_id.List_task when is_task_keyword_value_label label -> (
+      match Edn_util.as_keyword value with
+      | Some keyword -> human_header_label keyword
+      | None -> value_text value)
+  | _ -> value_text value
+
+let list_search_human ?(human_table_headers_order = Vec.empty) command value
+    config =
+  match Option.bind (Edn_util.get value "items") Edn_util.as_seq with
+  | None -> None
+  | Some items ->
+      let mapped = Vec.filter_map Edn_util.as_map items in
+      if Vec.length mapped <> Vec.length items then None
+      else
+        let title_width = title_max_display_width config in
+        let columns = table_columns ~human_table_headers_order mapped in
+        let headers = columns in
+        let rows =
+          mapped
+          |> Vec.map (fun fields ->
+              columns
+              |> Vec.map (fun label ->
+                  let value =
+                    fields |> field_by_label label
+                    |> Option.map (list_cell_value_text command label)
+                    |> Option.value ~default:""
+                  in
+                  if should_truncate_title command label then
+                    truncate_title_cell title_width value
+                  else value))
+        in
+        Some
+          (render_human
+             (Output.Human_output.create ~headers
+                ~footer:(count_footer (Vec.length rows))
+                ~rows ()))
+
+let graph_list_human value config =
+  match Edn_util.as_map value with
+  | Some fields -> (
+      let configured_graph =
+        config.Cli_config.graph |> Option.map Cli_primitive.string_of_graph
+      in
+      let current_graph =
+        match Vec.assoc_opt (Edn_util.keyword "current-graph") fields with
+        | Some value -> (
+            match Edn_util.as_string value with
+            | Some _ as graph -> graph
+            | None -> configured_graph)
+        | None -> configured_graph
+      in
+      match Vec.assoc_opt (Edn_util.keyword "graphs") fields with
+      | Some graphs_value -> (
+          match Edn_util.as_vector graphs_value with
+          | Some graphs ->
+              let rows =
+                Vec.map
+                  (fun graph ->
+                    let graph =
+                      Option.value (Edn_util.as_string graph)
+                        ~default:(Melange_edn_melange.to_edn_string graph)
+                    in
+                    let prefix =
+                      if Option.equal String.equal current_graph (Some graph)
+                      then "* "
+                      else if Option.is_some current_graph then "  "
+                      else ""
+                    in
+                    Vec.singleton (prefix ^ graph))
+                  graphs
+              in
+              render_human
+                (Output.Human_output.create
+                   ~footer:(count_footer (Vec.length rows))
+                   ~rows ())
+          | None -> "")
+      | None -> "")
+  | None -> ""
+
+let to_human ?human_table_headers_order result config =
+  let human_table_headers_order =
+    Option.value human_table_headers_order
+      ~default:result.Cli_result.human_table_headers_order
+  in
+  let output = result.Cli_result.output Output.Mode.Human in
+  match (result.Cli_result.command, result.data, output) with
+  | Some Command_id.Graph_list, Some (Cli_result.Raw value), Output.Human _ ->
+      graph_list_human value config
+  | Some Command_id.Query, Some (Cli_result.Query_result value), Output.Human _
+    ->
+      query_result_human value
+  | Some command, Some (Cli_result.Raw value), Output.Human _
+    when is_list_or_search_command command -> (
+      match
+        list_search_human ~human_table_headers_order command value config
+      with
+      | Some output -> output
+      | None -> (
+          match output with
+          | Output.Human human -> render_human human
+          | Output.Json _ | Output.Edn _ -> ""))
+  | _, _, Output.Human human -> render_human human
+  | _, _, (Output.Json _ | Output.Edn _) -> ""
+
+let format_error err _ =
+  "Error (" ^ Error.code_to_string err.Error.code ^ "): " ^ err.message
+
+let format_result ?human_table_headers_order result config =
+  match (result.Cli_result.command, result.data) with
+  | Some Command_id.Skill_show, Some (Cli_result.Message message) -> message
+  | _ -> (
+      match config.Cli_config.output_format with
+      | Some (Output.Mode.Packed Output.Mode.Json) -> to_json result
+      | Some (Output.Mode.Packed Output.Mode.Edn) -> to_edn result
+      | Some (Output.Mode.Packed Output.Mode.Human) | None -> (
+          match result.Cli_result.status with
+          | Ok -> to_human ?human_table_headers_order result config
+          | Error -> (
+              match result.error with
+              | Some err -> format_error err result.command
+              | None -> "")))
+
+let format_counted_table ~headers ~rows =
+  render_human
+    (Output.Human_output.create ~headers
+       ~footer:("Count: " ^ Humanize_types.format_count (Vec.length rows))
+       ~rows ())

cli/lib/global_opts.ml

@@ -0,0 +1,21 @@
+type t = {
+  graph : Cli_primitive.graph option;
+  root_dir : Cli_primitive.path option;
+  config_path : Cli_primitive.path option;
+  timeout_span : float option;
+  output_format : Output.Mode.packed option;
+  verbose : bool;
+  profile : bool;
+}
+
+let create ?graph ?root_dir ?config_path ?timeout_span ?output_format
+    ?(verbose = false) ?(profile = false) () =
+  {
+    graph;
+    root_dir;
+    config_path;
+    timeout_span;
+    output_format;
+    verbose;
+    profile;
+  }

cli/lib/graph_dir.ml

@@ -0,0 +1,73 @@
+let replace_all ~needle ~replacement text =
+  let needle_len = String.length needle in
+  if needle_len = 0 then invalid_arg "needle must not be empty";
+  let text_len = String.length text in
+  let buffer = Buffer.create text_len in
+  let rec loop index =
+    if index >= text_len then Buffer.contents buffer
+    else if
+      index + needle_len <= text_len
+      && String.sub text index needle_len = needle
+    then (
+      Buffer.add_string buffer replacement;
+      loop (index + needle_len))
+    else (
+      Buffer.add_char buffer text.[index];
+      loop (index + 1))
+  in
+  loop 0
+
+let encode_graph_dir_name graph_name =
+  graph_name |> Js.Global.encodeURIComponent
+  |> replace_all ~needle:"%20" ~replacement:" "
+  |> replace_all ~needle:"~" ~replacement:"%7E"
+  |> replace_all ~needle:"%" ~replacement:"~"
+
+let graph_dir_name_of_repo repo =
+  Cli_config.repo_to_graph repo
+  |> Cli_primitive.string_of_graph |> encode_graph_dir_name
+
+let contains_substring ~needle text =
+  let needle_len = String.length needle in
+  let text_len = String.length text in
+  let rec loop index =
+    index + needle_len <= text_len
+    && (String.sub text index needle_len = needle || loop (index + 1))
+  in
+  loop 0
+
+let decode_percent_graph_dir_name dir_name =
+  try Some (Js.Global.decodeURIComponent dir_name) with _ -> None
+
+let decode_graph_dir_name dir_name =
+  if
+    contains_substring ~needle:"++" dir_name
+    || contains_substring ~needle:"+3A+" dir_name
+  then None
+  else
+    dir_name
+    |> replace_all ~needle:"~" ~replacement:"%"
+    |> decode_percent_graph_dir_name
+
+let decode_legacy_graph_dir_name dir_name =
+  if
+    not
+      (contains_substring ~needle:"++" dir_name
+      || contains_substring ~needle:"+3A+" dir_name
+      || contains_substring ~needle:"%" dir_name)
+  then None
+  else
+    dir_name
+    |> replace_all ~needle:"+3A+" ~replacement:":"
+    |> replace_all ~needle:"++" ~replacement:"/"
+    |> decode_percent_graph_dir_name
+    |> fun graph_name ->
+    Option.bind graph_name (fun graph_name ->
+        if graph_name = "" then None else Some graph_name)
+
+let canonical_graph_name_of_dir dir_name =
+  match decode_graph_dir_name dir_name with
+  | Some graph_name
+    when graph_name <> "" && encode_graph_dir_name graph_name = dir_name ->
+      Some graph_name
+  | _ -> None

cli/lib/graph_types.ml

@@ -0,0 +1,11 @@
+type graph_item_kind = Canonical | Legacy | Legacy_undecodable
+
+type graph_item = {
+  kind : graph_item_kind;
+  graph_name : Cli_primitive.graph option;
+  graph_dir : Cli_primitive.path option;
+  legacy_dir : Cli_primitive.path option;
+  target_graph_dir : Cli_primitive.path option;
+  conflict : bool;
+  reason : Cli_primitive.keyword option;
+}

cli/lib/humanize_types.ml

@@ -0,0 +1,13 @@
+let format_count = Humanize.intcomma
+let pluralize_noun = Humanize.pluralize_noun
+
+let format_count_with_noun count noun =
+  format_count count ^ " " ^ pluralize_noun count noun
+
+let datetime = Humanize.datetime
+
+let relative_datetime ~then_time ~now_time =
+  let now = Time.time_to_epoch_seconds now_time in
+  let then_time = Time.time_to_epoch_seconds then_time in
+  Humanize.relative_datetime ~now ~number_format:string_of_int ~max_terms:1
+    then_time

cli/lib/id_parse.ml

@@ -0,0 +1,31 @@
+type parsed = { ids : Cli_primitive.db_id Rrbvec.t; multi : bool }
+
+let valid_id id = Int64.compare id 0L > 0
+
+let strip_vector_brackets value =
+  let value = String.trim value in
+  let len = String.length value in
+  if len >= 2 && value.[0] = '[' && value.[len - 1] = ']' then
+    String.sub value 1 (len - 2)
+  else value
+
+let parse_id_string s =
+  try
+    let split_ids value =
+      Vec.split_on_char ',' value
+      |> Vec.concat_map (fun part ->
+          Vec.split_on_char ' ' part
+          |> Vec.concat_map (fun part -> Vec.split_on_char '\t' part))
+    in
+    let ids =
+      strip_vector_brackets s |> split_ids
+      |> Vec.filter_map (fun p ->
+          let p = String.trim p in
+          if p = "" then None else Some (Int64.of_string p))
+    in
+    if Vec.for_all valid_id ids then Ok { ids; multi = Vec.length ids > 1 }
+    else Error (Error.invalid_options "invalid id")
+  with _ -> Error (Error.invalid_options "invalid id")
+
+let to_single parsed =
+  if Vec.length parsed.ids = 1 then Vec.nth_opt parsed.ids 0 else None

cli/lib/js_bytecode_stubs.c

@@ -0,0 +1,37 @@
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+
+CAMLprim value caml_js_from_string(value string) { return string; }
+
+CAMLprim value caml_js_to_string(value value) { return value; }
+
+CAMLprim value caml_js_var(value name) {
+  caml_failwith("JavaScript global lookup is unavailable outside wasm");
+}
+
+CAMLprim value caml_js_get(value object, value field) {
+  caml_failwith("JavaScript property access is unavailable outside wasm");
+}
+
+CAMLprim value caml_js_fun_call(value fn, value args) {
+  caml_failwith("JavaScript function call is unavailable outside wasm");
+}
+
+CAMLprim value caml_js_meth_call(value object, value method_name, value args) {
+  caml_failwith("JavaScript method call is unavailable outside wasm");
+}
+
+CAMLprim value caml_js_new(value constructor, value args) {
+  caml_failwith("JavaScript object construction is unavailable outside wasm");
+}
+
+CAMLprim value caml_js_object(value fields) {
+  caml_failwith("JavaScript object construction is unavailable outside wasm");
+}
+
+CAMLprim value caml_js_wrap_callback(value callback) { return callback; }
+
+CAMLprim value caml_js_eval_string(value source) {
+  caml_failwith("JavaScript eval is unavailable outside wasm");
+}

cli/lib/json_util.ml

@@ -0,0 +1,60 @@
+let max_safe_json_int = 9_007_199_254_740_991.
+
+let is_integral_float value =
+  Float.is_finite value
+  && value = floor value
+  && Float.abs value <= max_safe_json_int
+
+let rec value_of_json json =
+  match Js.Json.classify json with
+  | JSONNull -> Edn_util.nil
+  | JSONFalse -> Edn_util.bool false
+  | JSONTrue -> Edn_util.bool true
+  | JSONString value -> Edn_util.string value
+  | JSONNumber value ->
+      if is_integral_float value then Edn_util.int64 (Int64.of_float value)
+      else Edn_util.float value
+  | JSONArray values ->
+      Edn_util.vector_vec (values |> Rrbvec.of_array |> Vec.map value_of_json)
+  | JSONObject fields ->
+      fields |> Js.Dict.entries |> Rrbvec.of_array
+      |> Vec.map (fun (key, value) ->
+          (Edn_util.string key, value_of_json value))
+      |> Edn_util.map_vec
+
+let value_of_json_string text = Js.Json.parseExn text |> value_of_json
+let object_of_json_string text = Js.Json.decodeObject (Js.Json.parseExn text)
+
+let json_of_string_fields fields =
+  let object_ = Js.Dict.empty () in
+  Vec.iter
+    (fun (key, value) -> Js.Dict.set object_ key (Js.Json.string value))
+    fields;
+  Js.Json.object_ object_
+
+let string_of_string_fields fields =
+  fields |> json_of_string_fields |> Js.Json.stringify
+
+let field object_ key = Js.Dict.get object_ key
+
+let string_field object_ key =
+  Option.bind (field object_ key) Js.Json.decodeString
+
+let number_field object_ key =
+  Option.bind (field object_ key) Js.Json.decodeNumber
+
+let int64_field object_ key =
+  match number_field object_ key with
+  | Some value when is_integral_float value -> Some (Int64.of_float value)
+  | _ -> None
+
+let object_field object_ key =
+  match field object_ key with
+  | Some value -> Js.Json.decodeObject value
+  | None -> None
+
+let nested_string_field object_ object_key field_key =
+  match object_field object_ object_key with
+  | Some object_ ->
+      Option.bind (Js.Dict.get object_ field_key) Js.Json.decodeString
+  | None -> None

cli/lib/log_types.ml

@@ -0,0 +1,27 @@
+type preview = { preview : string; length : int; truncated : bool }
+type level = Debug | Info | Warn | Error
+
+type record = {
+  time : Js.Date.t option;
+  level : level;
+  logger : string option;
+  message : string;
+  exception_ : string option;
+}
+
+let default_preview_limit = 400
+let handler_installed = ref false
+
+let truncate_preview ?(max_len = default_preview_limit) value =
+  let limit = max 0 max_len in
+  let text =
+    match Edn_util.as_string value with
+    | Some value -> value
+    | None -> Melange_edn_melange.to_edn_string value
+  in
+  let length = String.length text in
+  let truncated = length > limit in
+  let preview = if truncated then String.sub text 0 limit else text in
+  { preview; length; truncated }
+
+let install_stderr_handler () = handler_installed := true

cli/lib/output.ml

@@ -0,0 +1,144 @@
+type human
+type json
+type edn
+
+module Mode = struct
+  type _ t = Human : human t | Json : json t | Edn : edn t
+  and packed = Packed : _ t -> packed
+
+  let default = Human
+
+  let of_string = function
+    | "human" -> Some (Packed Human)
+    | "json" -> Some (Packed Json)
+    | "edn" -> Some (Packed Edn)
+    | _ -> None
+
+  let to_string : type a. a t -> string = function
+    | Human -> "human"
+    | Json -> "json"
+    | Edn -> "edn"
+
+  let structured : type a. a t -> bool = function
+    | Human -> false
+    | Json | Edn -> true
+end
+
+module Human_output = struct
+  type t = {
+    headers : string Rrbvec.t option;
+    rows : string Rrbvec.t Rrbvec.t;
+    footer : string option;
+  }
+
+  let create ?headers ?footer ~rows () = { headers; rows; footer }
+
+  let has_suffix ~suffix value =
+    let suffix_len = String.length suffix in
+    let value_len = String.length value in
+    value_len >= suffix_len
+    && String.sub value (value_len - suffix_len) suffix_len = suffix
+
+  let is_datetime_header header =
+    let header = String.lowercase_ascii header in
+    has_suffix ~suffix:"created-at" header
+    || has_suffix ~suffix:"updated-at" header
+
+  let display_cell ~now_time ?header value =
+    let value = if value = "" then "-" else value in
+    match header with
+    | Some header when is_datetime_header header -> (
+        match Int64.of_string_opt value with
+        | Some epoch_ms ->
+            Humanize_types.relative_datetime
+              ~then_time:(Time.time_of_epoch_ms epoch_ms)
+              ~now_time
+        | None -> value)
+    | _ -> value
+
+  let display_rows t =
+    let now_time = Time.now () in
+    let headers = Option.value t.headers ~default:Vec.empty in
+    Vec.map
+      (fun row ->
+        Vec.mapi
+          (fun index value ->
+            let header =
+              match Vec.nth_opt headers index with
+              | Some header when is_datetime_header header -> Some header
+              | Some header
+                when String.lowercase_ascii header = "value"
+                     && Vec.length row >= 2 ->
+                  Vec.nth_opt row 0
+              | header -> header
+            in
+            display_cell ~now_time ?header value)
+          row)
+      t.rows
+
+  let column_widths rows =
+    rows
+    |> Vec.fold_left
+         (fun widths row ->
+           let width = max (Vec.length widths) (Vec.length row) in
+           Vec.init width (fun index ->
+               max
+                 (Option.value (Vec.nth_opt widths index) ~default:0)
+                 (Display_width.width
+                    (Option.value (Vec.nth_opt row index) ~default:""))))
+         Vec.empty
+
+  let pad_right width value =
+    let padding = width - Display_width.width value in
+    if padding <= 0 then value else value ^ String.make padding ' '
+
+  let render_row widths row =
+    let last_index = Vec.length widths - 1 in
+    widths
+    |> Vec.mapi (fun index width ->
+        let value = Option.value (Vec.nth_opt row index) ~default:"" in
+        if index = last_index then value else pad_right width value)
+    |> Vec.string_concat "  "
+
+  let strip_leading_colon value =
+    if String.length value > 0 && value.[0] = ':' then
+      String.sub value 1 (String.length value - 1)
+    else value
+
+  let is_keyword_namespace_char = function
+    | 'a' .. 'z' | '0' .. '9' | '.' | '-' | '_' -> true
+    | _ -> false
+
+  let is_keyword_namespace value =
+    value <> "" && String.for_all is_keyword_namespace_char value
+
+  let display_header header =
+    let header = strip_leading_colon header in
+    let parts = Vec.split_on_char '/' header in
+    if Vec.length parts = 2 then
+      let namespace = Vec.nth parts 0 in
+      let name = Vec.nth parts 1 in
+      if is_keyword_namespace namespace && name <> "" then name else header
+    else header
+
+  let lines t =
+    let rows = display_rows t in
+    let table_rows =
+      match t.headers with
+      | None -> rows
+      | Some headers when Vec.is_empty headers -> rows
+      | Some headers -> Vec.push_front rows (Vec.map display_header headers)
+    in
+    let widths = column_widths table_rows in
+    let lines = Vec.map (render_row widths) table_rows in
+    match t.footer with
+    | Some footer -> Vec.push_back lines footer
+    | None -> lines
+
+  let to_string t = Vec.string_concat "\n" (lines t)
+end
+
+type _ t =
+  | Human : Human_output.t -> human t
+  | Edn : Melange_edn_melange.any -> edn t
+  | Json : Melange_edn_melange.any -> json t

cli/lib/output_mode.ml

@@ -0,0 +1,18 @@
+type t = Output.Mode.packed
+
+let all =
+  [
+    Output.Mode.Packed Output.Mode.Human;
+    Output.Mode.Packed Output.Mode.Json;
+    Output.Mode.Packed Output.Mode.Edn;
+  ]
+
+let default = Output.Mode.Packed Output.Mode.Human
+let of_string = Output.Mode.of_string
+let to_string (Output.Mode.Packed mode) = Output.Mode.to_string mode
+let structured (Output.Mode.Packed mode) = Output.Mode.structured mode
+let merge_preference xs = Vec.find_map (fun x -> x) xs
+let for_config config = Option.value config.Cli_config.output_format ~default
+
+let error ?command ?context mode err =
+  Cli_result.error ?command ?context mode err

cli/lib/platform/node/cli_effect.ml

@@ -0,0 +1,134 @@
+type 'a state = Pending | Resolved of 'a | Rejected of exn
+
+type 'a t = {
+  mutable state : 'a state;
+  mutable callbacks : ('a state -> unit) Rrbvec.t;
+}
+
+type 'a resolver = 'a t
+
+let pure value = { state = Resolved value; callbacks = Rrbvec.empty }
+let error exn = { state = Rejected exn; callbacks = Rrbvec.empty }
+
+let is_pending task =
+  match task.state with Pending -> true | Resolved _ | Rejected _ -> false
+
+let wait () =
+  let task = { state = Pending; callbacks = Rrbvec.empty } in
+  (task, task)
+
+let notify task state =
+  if is_pending task then (
+    task.state <- state;
+    let callbacks = Rrbvec.rev task.callbacks in
+    task.callbacks <- Rrbvec.empty;
+    Rrbvec.iter (fun callback -> callback state) callbacks)
+
+let wakeup resolver value = notify resolver (Resolved value)
+let reject resolver exn = notify resolver (Rejected exn)
+
+let on_state task callback =
+  match task.state with
+  | Pending -> task.callbacks <- Rrbvec.push_front task.callbacks callback
+  | state -> callback state
+
+let bind task f =
+  let result, resolver = wait () in
+  on_state task (function
+    | Pending -> ()
+    | Resolved value -> (
+        try
+          let next = f value in
+          on_state next (function
+            | Pending -> ()
+            | Resolved value -> wakeup resolver value
+            | Rejected exn -> reject resolver exn)
+        with exn -> reject resolver exn)
+    | Rejected exn -> reject resolver exn);
+  result
+
+module Infix = struct
+  let ( >>= ) = bind
+end
+
+let map f task = bind task (fun value -> pure (f value))
+
+let rec map_s f values =
+  match Rrbvec.pop_front values with
+  | None -> pure Rrbvec.empty
+  | Some (value, rest) ->
+      bind (f value) (fun mapped ->
+          map
+            (fun mapped_rest -> Rrbvec.push_front mapped_rest mapped)
+            (map_s f rest))
+
+let both left right =
+  bind left (fun left_value ->
+      map (fun right_value -> (left_value, right_value)) right)
+
+let all tasks =
+  let result, resolver = wait () in
+  let pending = ref (Rrbvec.length tasks) in
+  let values = Array.make (Rrbvec.length tasks) None in
+  let finish_if_ready () =
+    if !pending = 0 && is_pending result then
+      wakeup resolver (values |> Array.map Option.get |> Rrbvec.of_array)
+  in
+  Rrbvec.iteri
+    (fun index task ->
+      on_state task (function
+        | Pending -> ()
+        | Resolved value ->
+            values.(index) <- Some value;
+            decr pending;
+            finish_if_ready ()
+        | Rejected exn -> if is_pending result then reject resolver exn))
+    tasks;
+  finish_if_ready ();
+  result
+
+let catch value handler =
+  let result, resolver = wait () in
+  on_state value (function
+    | Pending -> ()
+    | Resolved value -> wakeup resolver value
+    | Rejected exn -> (
+        try
+          let next = handler exn in
+          on_state next (function
+            | Pending -> ()
+            | Resolved value -> wakeup resolver value
+            | Rejected exn -> reject resolver exn)
+        with exn -> reject resolver exn));
+  result
+
+let finally value f =
+  let result, resolver = wait () in
+  let finish state =
+    let cleanup = try f () with exn -> error exn in
+    on_state cleanup (function
+      | Pending -> ()
+      | Resolved () -> (
+          match state with
+          | Pending -> ()
+          | Resolved value -> wakeup resolver value
+          | Rejected exn -> reject resolver exn)
+      | Rejected exn -> reject resolver exn)
+  in
+  on_state value finish;
+  result
+
+let async f = ignore (catch (f ()) (fun _ -> pure ()) : unit t)
+
+let on_any task on_ok on_error =
+  on_state task (function
+    | Pending -> ()
+    | Resolved value -> on_ok value
+    | Rejected exn -> on_error exn)
+
+let sleep span =
+  let task, resolver = wait () in
+  ignore
+    (Js.Global.setTimeout ~f:(fun () -> wakeup resolver ()) (int_of_float span)
+      : Js.Global.timeoutId);
+  task

cli/lib/platform/node/cli_platform.ml

@@ -0,0 +1,378 @@
+open Cli_effect.Infix
+
+let hostname = Cli_unix.gethostname
+
+module Stdout = struct
+  type writable
+
+  external stdout : writable = "stdout" [@@mel.module "process"]
+
+  external on_error :
+    writable -> (_[@mel.as "error"]) -> ((Js.Exn.t -> unit)[@u]) -> unit = "on"
+  [@@mel.send]
+
+  external error_code : Js.Exn.t -> string option = "code"
+  [@@mel.get] [@@mel.return { undefined_to_opt }]
+end
+
+let stdout_error_handler_installed = ref false
+
+let install_stdout_error_handler () =
+  if not !stdout_error_handler_installed then (
+    stdout_error_handler_installed := true;
+    Stdout.on_error Stdout.stdout (fun[@u] error ->
+        match Stdout.error_code error with
+        | Some "EPIPE" -> exit 0
+        | _ ->
+            Js.Exn.raiseError
+              (Option.value (Js.Exn.message error) ~default:"JavaScript error")))
+
+let argv () =
+  install_stdout_error_handler ();
+  Node.Process.argv
+
+type login_callback_request = { target : string option }
+type login_callback_response = { status : int; body : string }
+
+type login_callback_server_error =
+  | Login_callback_timeout
+  | Login_callback_server_start_failed of string
+  | Login_callback_server_aborted of string
+
+let timeout_ms span = if Float.compare span 0. > 0 then int_of_float span else 0
+
+module Timer = struct
+  let set_timeout f ms = Js.Global.setTimeout ~f ms
+  let clear_timeout = Js.Global.clearTimeout
+end
+
+module Http_server = struct
+  type server
+  type request
+  type response
+
+  external create_server : ((request -> response -> unit)[@u]) -> server
+    = "createServer"
+  [@@mel.module "http"]
+
+  external listen : server -> int -> string -> ((unit -> unit)[@u]) -> unit
+    = "listen"
+  [@@mel.send]
+
+  external on_error :
+    server -> (_[@mel.as "error"]) -> ((Js.Exn.t -> unit)[@u]) -> unit = "on"
+  [@@mel.send]
+
+  external close : server -> ((unit -> unit)[@u]) -> unit = "close" [@@mel.send]
+
+  external target : request -> string option = "url"
+  [@@mel.get] [@@mel.return { undefined_to_opt }]
+
+  external write_head : response -> int -> string Js.Dict.t -> unit
+    = "writeHead"
+  [@@mel.send]
+
+  external end_ : response -> string -> ((unit -> unit)[@u]) -> unit = "end"
+  [@@mel.send]
+
+  let text_headers () =
+    let headers = Js.Dict.empty () in
+    Js.Dict.set headers "Content-Type" "text/plain; charset=utf-8";
+    Js.Dict.set headers "Connection" "close";
+    headers
+
+  let close_ignore server = try close server (fun[@u] () -> ()) with _ -> ()
+end
+
+let js_error_message exn =
+  match Js.Exn.message exn with
+  | Some message when String.trim message <> "" -> message
+  | _ -> "JavaScript error"
+
+let login_callback_server ~host ~port ~timeout_span ~on_listen ~handle_request =
+  let task, resolver = Cli_effect.wait () in
+  let settled = ref false in
+  let server_ref = ref None in
+  let timeout_ref = ref None in
+  let clear_timer () =
+    match !timeout_ref with
+    | None -> ()
+    | Some timeout_handle ->
+        timeout_ref := None;
+        Timer.clear_timeout timeout_handle
+  in
+  let close_server () =
+    match !server_ref with
+    | None -> ()
+    | Some server ->
+        server_ref := None;
+        Http_server.close_ignore server
+  in
+  let finish result =
+    if not !settled then (
+      settled := true;
+      clear_timer ();
+      close_server ();
+      Cli_effect.wakeup resolver result)
+  in
+  let on_request request response =
+    if !settled then (
+      Http_server.write_head response 410 (Http_server.text_headers ());
+      Http_server.end_ response "Login callback already handled" (fun[@u] () ->
+          ()))
+    else
+      let response_body, result =
+        handle_request { target = Http_server.target request }
+      in
+      finish (Ok result);
+      Http_server.write_head response response_body.status
+        (Http_server.text_headers ());
+      Http_server.end_ response response_body.body (fun[@u] () ->
+          match !server_ref with
+          | None -> ()
+          | Some server -> Http_server.close_ignore server)
+  in
+  let on_listening () =
+    let timeout = timeout_ms timeout_span in
+    if timeout > 0 then
+      timeout_ref :=
+        Some
+          (Timer.set_timeout
+             (fun () -> finish (Error Login_callback_timeout))
+             timeout);
+    Cli_effect.on_any (on_listen ())
+      (function
+        | Ok () -> ()
+        | Error message ->
+            finish (Error (Login_callback_server_aborted message)))
+      (fun exn ->
+        finish (Error (Login_callback_server_aborted (Printexc.to_string exn))))
+  in
+  try
+    let server =
+      Http_server.create_server (fun[@u] request response ->
+          on_request request response)
+    in
+    server_ref := Some server;
+    Http_server.on_error server (fun[@u] error ->
+        finish
+          (Error (Login_callback_server_start_failed (js_error_message error))));
+    Http_server.listen server port host (fun[@u] () -> on_listening ());
+    task
+  with exn ->
+    finish (Error (Login_callback_server_start_failed (Printexc.to_string exn)));
+    task
+
+module Symbols = struct
+  let ellipsis = Js.String.fromCodePoint 0x2026
+  let linked_arrow = Js.String.fromCodePoint 0x2192 ^ " "
+  let tree_line = Js.String.fromCodePoint 0x2500
+  let tree_last = Js.String.fromCodePoint 0x2514 ^ tree_line ^ tree_line ^ " "
+  let tree_middle = Js.String.fromCodePoint 0x251c ^ tree_line ^ tree_line ^ " "
+  let tree_pipe = Js.String.fromCodePoint 0x2502 ^ "   "
+end
+
+module HTTP = struct
+  external promise_error_name : Js.Promise.error -> string option = "name"
+  [@@mel.get] [@@mel.return { undefined_to_opt }]
+
+  external promise_error_message : Js.Promise.error -> string option = "message"
+  [@@mel.get] [@@mel.return { undefined_to_opt }]
+
+  let promise_to_effect ?(on_settle = fun () -> ()) promise =
+    let task, resolver = Cli_effect.wait () in
+    let finish result =
+      if Cli_effect.is_pending task then Cli_effect.wakeup resolver result
+    in
+    let on_ok value =
+      on_settle ();
+      finish (Ok value);
+      Js.Promise.resolve ()
+    in
+    let on_error error =
+      let message =
+        match promise_error_name error with
+        | Some "AbortError" -> "request timeout"
+        | _ ->
+            Option.value
+              (promise_error_message error)
+              ~default:"JavaScript promise rejected"
+      in
+      on_settle ();
+      finish (Error message);
+      Js.Promise.resolve ()
+    in
+    ignore
+      (promise |> Js.Promise.then_ on_ok |> Js.Promise.catch on_error
+        : unit Js.Promise.t);
+    task >>= function
+    | Ok value -> Cli_effect.pure value
+    | Error message -> Cli_effect.error (Failure message)
+
+  let timeout_ms = function
+    | Some timeout_span when Float.compare timeout_span 0. > 0 ->
+        int_of_float timeout_span
+    | _ -> 0
+
+  let is_body_forbidden = function Fetch.Get | Fetch.Head -> true | _ -> false
+
+  let request_body method_ body =
+    if is_body_forbidden method_ && body <> "" then
+      invalid_arg "GET and HEAD requests must not include a body"
+    else if body = "" then None
+    else Some (Fetch.BodyInit.make body)
+
+  let timeout controller timeout_span =
+    match timeout_ms timeout_span with
+    | 0 -> None
+    | ms ->
+        Some
+          (Timer.set_timeout
+             (fun () -> Fetch.AbortController.abort controller)
+             ms)
+
+  let clear_timeout_opt = function
+    | None -> ()
+    | Some timeout_handle -> Timer.clear_timeout timeout_handle
+
+  let response_text response =
+    Fetch.Response.text response
+    |> Js.Promise.then_ (fun body -> Js.Promise.resolve (response, body))
+
+  let request ?timeout_span method_ url ~headers ~body =
+    let controller = Fetch.AbortController.make () in
+    let timeout_handle = timeout controller timeout_span in
+    let body = request_body method_ body in
+    let init =
+      Fetch.RequestInit.make ~method_
+        ~headers:(Fetch.HeadersInit.makeWithArray (Rrbvec.to_array headers))
+        ?body
+        ~signal:(Fetch.AbortController.signal controller)
+        ()
+    in
+    promise_to_effect
+      ~on_settle:(fun () -> clear_timeout_opt timeout_handle)
+      (Fetch.fetchWithInit url init |> Js.Promise.then_ response_text)
+end
+
+module Crypto = struct
+  module Node_crypto = struct
+    type hash
+
+    external create_hash : string -> hash = "createHash" [@@mel.module "crypto"]
+    external update : hash -> string -> string -> hash = "update" [@@mel.send]
+    external digest : hash -> string -> string = "digest" [@@mel.send]
+
+    external random_bytes : int -> Node.Buffer.t = "randomBytes"
+    [@@mel.module "crypto"]
+  end
+
+  let sha256_digest output_encoding text =
+    let hash = Node_crypto.create_hash "sha256" in
+    let hash = Node_crypto.update hash text "latin1" in
+    Node_crypto.digest hash output_encoding
+
+  let sha256_hex text = sha256_digest "hex" text
+  let sha256_base64url text = sha256_digest "base64url" text
+
+  let random_base64url size =
+    let text =
+      Node_crypto.random_bytes size |> Node.Buffer.toString ~encoding:`base64url
+    in
+    if String.length text <= size then text else String.sub text 0 size
+
+  let base64url_decode text =
+    Node.Buffer.fromStringWithEncoding text ~encoding:`base64url
+    |> Node.Buffer.toString ~encoding:`utf8
+end
+
+module Events = struct
+  type subscription = { close : unit -> unit Cli_effect.t }
+  type readable_stream
+  type reader
+  type read_result
+  type text_decoder
+  type uint8_array
+
+  external response_body : Fetch.Response.t -> readable_stream option = "body"
+  [@@mel.get] [@@mel.return { null_to_opt }]
+
+  external get_reader : readable_stream -> reader = "getReader" [@@mel.send]
+  external read : reader -> read_result Js.Promise.t = "read" [@@mel.send]
+  external cancel : reader -> unit Js.Promise.t = "cancel" [@@mel.send]
+  external read_done : read_result -> bool = "done" [@@mel.get]
+
+  external read_value : read_result -> uint8_array option = "value"
+  [@@mel.get] [@@mel.return { undefined_to_opt }]
+
+  external make_decoder : unit -> text_decoder = "TextDecoder" [@@mel.new]
+
+  external decode :
+    text_decoder -> uint8_array -> < stream : bool > Js.t -> string = "decode"
+  [@@mel.send]
+
+  let stream_options =
+    let options = Js.Obj.empty () in
+    Js.Obj.assign options [%obj { stream = true }]
+
+  let rec read_loop closed decoder reader on_chunk =
+    if !closed then Js.Promise.resolve ()
+    else
+      read reader
+      |> Js.Promise.then_ (fun result ->
+          if !closed || read_done result then Js.Promise.resolve ()
+          else (
+            result |> read_value
+            |> Option.iter (fun value ->
+                on_chunk (decode decoder value stream_options));
+            read_loop closed decoder reader on_chunk))
+
+  let connect ~url ~on_chunk =
+    let closed = ref false in
+    let reader_ref = ref None in
+    let controller = Fetch.AbortController.make () in
+    let init =
+      Fetch.RequestInit.make ~method_:Fetch.Get
+        ~headers:
+          (Fetch.HeadersInit.makeWithArray
+             [| ("Accept", "text/event-stream") |])
+        ~signal:(Fetch.AbortController.signal controller)
+        ()
+    in
+    Cli_effect.bind
+      (HTTP.promise_to_effect (Fetch.fetchWithInit url init))
+      (fun response ->
+        if not (Fetch.Response.ok response) then
+          Cli_effect.error
+            (Js.Exn.raiseError
+               ("events request failed ("
+               ^ string_of_int (Fetch.Response.status response)
+               ^ ")"))
+        else
+          let request =
+            (match response_body response with
+              | None ->
+                  Fetch.Response.text response
+                  |> Js.Promise.then_ (fun text ->
+                      if not !closed then on_chunk text;
+                      Js.Promise.resolve ())
+              | Some body ->
+                  let reader = get_reader body in
+                  reader_ref := Some reader;
+                  read_loop closed (make_decoder ()) reader on_chunk)
+            |> Js.Promise.catch (fun _ -> Js.Promise.resolve ())
+          in
+          let close () =
+            Fetch.AbortController.abort controller;
+            (match !reader_ref with
+            | None -> ()
+            | Some reader ->
+                ignore
+                  (cancel reader
+                   |> Js.Promise.catch (fun _ -> Js.Promise.resolve ())
+                    : unit Js.Promise.t));
+            Cli_effect.catch (HTTP.promise_to_effect request) (fun _ ->
+                Cli_effect.pure ())
+          in
+          Cli_effect.pure { close })
+end

cli/lib/platform/node/cli_unix.ml

@@ -0,0 +1,463 @@
+type error = EAGAIN | EWOULDBLOCK | ETIMEDOUT | ESRCH | EPERM
+type access_permission = R_OK | W_OK
+type open_flag = O_RDWR
+type file_descr = int
+type stats = { st_size : int; st_mtime : float }
+type process_result = { status : int; stdout : string; stderr : string }
+type mkdir_result = Created | Already_exists
+
+exception Cli_unix_error of error * string * string
+
+module Fs = struct
+  type mkdir_options
+  type rm_options
+  type stat
+
+  external mkdir_options : mode:int -> unit -> mkdir_options = "" [@@mel.obj]
+
+  external rm_options : recursive:bool -> force:bool -> unit -> rm_options = ""
+  [@@mel.obj]
+
+  external mkdir_sync : string -> mkdir_options -> unit = "mkdirSync"
+  [@@mel.module "fs"]
+
+  external stat_sync : string -> stat = "statSync" [@@mel.module "fs"]
+
+  external read_fd_utf8_sync : int -> (_[@mel.as "utf8"]) -> string
+    = "readFileSync"
+  [@@mel.module "fs"]
+
+  external copy_file_sync : string -> string -> unit = "copyFileSync"
+  [@@mel.module "fs"]
+
+  external rm_sync : string -> rm_options -> unit = "rmSync" [@@mel.module "fs"]
+  external chmod_sync : string -> int -> unit = "chmodSync" [@@mel.module "fs"]
+
+  external access_sync : string -> int -> unit = "accessSync"
+  [@@mel.module "fs"]
+
+  external open_sync : string -> string -> int = "openSync" [@@mel.module "fs"]
+  external close_sync : int -> unit = "closeSync" [@@mel.module "fs"]
+  external mkdtemp_sync : string -> string = "mkdtempSync" [@@mel.module "fs"]
+  external size : stat -> int = "size" [@@mel.get]
+  external mtime_ms : stat -> float = "mtimeMs" [@@mel.get]
+  external is_directory : stat -> bool = "isDirectory" [@@mel.send]
+end
+
+module Os = struct
+  external hostname : unit -> string = "hostname" [@@mel.module "os"]
+  external tmpdir : unit -> string = "tmpdir" [@@mel.module "os"]
+end
+
+module Process = struct
+  type writable
+
+  external pid : int = "pid" [@@mel.module "process"]
+  external stdout : writable = "stdout" [@@mel.module "process"]
+  external kill : int -> int -> unit = "kill" [@@mel.module "process"]
+  external write : writable -> string -> bool = "write" [@@mel.send]
+end
+
+module Child_process = struct
+  type spawn_options
+  type spawn_sync_options
+  type child
+  type spawn_result
+
+  external spawn_options :
+    ?detached:bool ->
+    ?stdio:Js.Json.t array ->
+    ?env:string Js.Dict.t ->
+    ?shell:bool ->
+    unit ->
+    spawn_options = ""
+  [@@mel.obj]
+
+  external spawn_sync_options :
+    ?encoding:string ->
+    ?env:string Js.Dict.t ->
+    ?shell:bool ->
+    unit ->
+    spawn_sync_options = ""
+  [@@mel.obj]
+
+  external spawn : string -> string array -> spawn_options -> child = "spawn"
+  [@@mel.module "child_process"]
+
+  external spawn_sync :
+    string -> string array -> spawn_sync_options -> spawn_result = "spawnSync"
+  [@@mel.module "child_process"]
+
+  external pid : child -> int Js.nullable = "pid" [@@mel.get]
+  external unref : child -> unit = "unref" [@@mel.send]
+  external status : spawn_result -> int Js.nullable = "status" [@@mel.get]
+  external stdout : spawn_result -> string Js.nullable = "stdout" [@@mel.get]
+  external stderr : spawn_result -> string Js.nullable = "stderr" [@@mel.get]
+  external error : spawn_result -> Js.Exn.t Js.nullable = "error" [@@mel.get]
+end
+
+module Atomics_sleep = struct
+  type shared_array_buffer
+  type int32_array
+
+  external make_shared_array_buffer : int -> shared_array_buffer
+    = "SharedArrayBuffer"
+  [@@mel.new]
+
+  external make_int32_array : shared_array_buffer -> int32_array = "Int32Array"
+  [@@mel.new]
+
+  external wait : int32_array -> int -> int -> int -> string = "wait"
+  [@@mel.scope "Atomics"]
+
+  let buffer = make_int32_array (make_shared_array_buffer 4)
+  let sleep_ms ms = ignore (wait buffer 0 0 ms : string)
+end
+
+external error_code : Js.Exn.t -> string option = "code" [@@mel.get]
+
+let js_error_message exn =
+  match Js.Exn.asJsExn exn with
+  | Some error ->
+      Option.value (Js.Exn.message error) ~default:(Printexc.to_string exn)
+  | None -> Printexc.to_string exn
+
+let js_error_code exn =
+  match Js.Exn.asJsExn exn with Some error -> error_code error | None -> None
+
+let unix_error_of_code = function
+  | Some "EAGAIN" -> EAGAIN
+  | Some "EWOULDBLOCK" -> EWOULDBLOCK
+  | Some "ETIMEDOUT" -> ETIMEDOUT
+  | Some ("ENOENT" | "ESRCH") -> ESRCH
+  | Some ("EACCES" | "EPERM") -> EPERM
+  | _ -> EPERM
+
+let raise_error ?error op detail exn =
+  let detail =
+    let message = js_error_message exn in
+    if String.trim message = "" then detail else message
+  in
+  let error =
+    Option.value error ~default:(unix_error_of_code (js_error_code exn))
+  in
+  raise (Cli_unix_error (error, op, detail))
+
+let run_unit op detail fn = try fn () with exn -> raise_error op detail exn
+
+let mkdir path perm =
+  run_unit "mkdir" path (fun () ->
+      Fs.mkdir_sync path (Fs.mkdir_options ~mode:perm ()))
+
+let rmdir path = run_unit "rmdir" path (fun () -> Node.Fs.rmdirSync path)
+
+let mkdir_exclusive path perm =
+  try
+    Fs.mkdir_sync path (Fs.mkdir_options ~mode:perm ());
+    Created
+  with exn -> (
+    match js_error_code exn with
+    | Some "EEXIST" -> Already_exists
+    | _ -> raise_error "mkdir" path exn)
+
+let file_exists = Node.Fs.existsSync
+
+let is_directory path =
+  try Fs.is_directory (Fs.stat_sync path) with _ -> false
+
+let readdir path =
+  try Node.Fs.readdirSync path with exn -> raise_error "readdir" path exn
+
+let rec mkdir_p path =
+  if path = "" || path = Filename.dirname path || file_exists path then ()
+  else (
+    mkdir_p (Filename.dirname path);
+    match mkdir_exclusive path 0o755 with Created | Already_exists -> ())
+
+let write_text_file path content =
+  run_unit "write" path (fun () -> Node.Fs.writeFileAsUtf8Sync path content)
+
+let read_text_file path =
+  try Node.Fs.readFileAsUtf8Sync path with exn -> raise_error "read" path exn
+
+let read_stdin_all () =
+  try Fs.read_fd_utf8_sync 0 with exn -> raise_error "read" "stdin" exn
+
+let write_binary_file path content =
+  run_unit "write" path (fun () -> Node.Fs.writeFileSync path content `latin1)
+
+let read_binary_file path =
+  try Node.Fs.readFileSync path `latin1
+  with exn -> raise_error "read" path exn
+
+let copy_file source destination =
+  run_unit "copy" source (fun () -> Fs.copy_file_sync source destination)
+
+let remove_tree path =
+  run_unit "rm" path (fun () ->
+      Fs.rm_sync path (Fs.rm_options ~recursive:true ~force:true ()))
+
+let rename source destination =
+  run_unit "rename" source (fun () -> Node.Fs.renameSync source destination)
+
+let getpid () = Process.pid
+
+let process_running pid =
+  pid > 0
+  &&
+    try
+      Process.kill pid 0;
+      true
+    with exn -> (
+      match js_error_code exn with Some "ESRCH" -> false | _ -> true)
+
+let chmod path perm = run_unit "chmod" path (fun () -> Fs.chmod_sync path perm)
+
+let access path permissions =
+  let flag =
+    Rrbvec.fold_left
+      (fun acc -> function R_OK -> acc lor 4 | W_OK -> acc lor 2)
+      0 permissions
+  in
+  try Fs.access_sync path flag
+  with _ ->
+    if file_exists path then raise (Cli_unix_error (EPERM, "access", path))
+    else raise (Cli_unix_error (ESRCH, "access", path))
+
+let stat path =
+  try
+    let stat = Fs.stat_sync path in
+    { st_size = Fs.size stat; st_mtime = Fs.mtime_ms stat /. 1000. }
+  with exn -> raise_error "stat" path exn
+
+let environment () =
+  Node.Process.process##env |> Js.Dict.entries
+  |> Array.map (fun (key, value) -> key ^ "=" ^ value)
+
+let gethostname () = try Os.hostname () with _ -> ""
+let openfile _path _flags _perm = 0
+let close _fd = ()
+
+let command_args argv =
+  let argv = Rrbvec.of_array argv in
+  match Rrbvec.pop_front argv with
+  | Some ("env", rest) -> (
+      match Rrbvec.pop_front rest with
+      | Some (command, args) -> (command, args)
+      | None ->
+          raise
+            (Cli_unix_error (EPERM, "create_process_env", "missing command")))
+  | Some (command, args) -> (command, args)
+  | None ->
+      raise (Cli_unix_error (EPERM, "create_process_env", "missing command"))
+
+let copy_env env =
+  let result = Js.Dict.empty () in
+  Node.Process.process##env |> Js.Dict.entries
+  |> Array.iter (fun (key, value) -> Js.Dict.set result key value);
+  Array.iter
+    (fun entry ->
+      match String.index_opt entry '=' with
+      | None -> ()
+      | Some index ->
+          Js.Dict.set result (String.sub entry 0 index)
+            (String.sub entry (index + 1) (String.length entry - index - 1)))
+    env;
+  result
+
+let stdio_ignore =
+  [|
+    Js.Json.string "ignore"; Js.Json.string "ignore"; Js.Json.string "ignore";
+  |]
+
+let spawn_detached command args env =
+  let child =
+    Child_process.spawn command (Rrbvec.to_array args)
+      (Child_process.spawn_options ~detached:true ~stdio:stdio_ignore
+         ~env:(copy_env env) ~shell:false ())
+  in
+  Child_process.unref child;
+  Child_process.pid child |> Js.Nullable.toOption |> Option.value ~default:0
+
+let windows_verbatim_spawn_options env : Child_process.spawn_options =
+  let make : string Js.Dict.t -> Js.Json.t array -> Child_process.spawn_options
+      =
+    [%mel.raw
+      {|
+function (env, stdio) {
+  return {
+    detached: true,
+    stdio: stdio,
+    env: env,
+    shell: false,
+    windowsVerbatimArguments: true
+  };
+}
+|}]
+  in
+  make (copy_env env) stdio_ignore
+
+let spawn_detached_windows_verbatim command args env =
+  let child =
+    Child_process.spawn command (Rrbvec.to_array args)
+      (windows_verbatim_spawn_options env)
+  in
+  Child_process.unref child;
+  Child_process.pid child |> Js.Nullable.toOption |> Option.value ~default:0
+
+let create_process_env _prog argv env _stdin _stdout _stderr =
+  let command, args = command_args argv in
+  try spawn_detached command args env
+  with exn -> raise_error "create_process_env" command exn
+
+let nullable_string_default value =
+  value |> Js.Nullable.toOption |> Option.value ~default:""
+
+let run_process_capture command args env =
+  let result =
+    Child_process.spawn_sync command (Rrbvec.to_array args)
+      (Child_process.spawn_sync_options ~encoding:"utf8" ~env:(copy_env env)
+         ~shell:false ())
+  in
+  let status =
+    result |> Child_process.status |> Js.Nullable.toOption
+    |> Option.value ~default:1
+  in
+  let stderr =
+    match result |> Child_process.error |> Js.Nullable.toOption with
+    | Some error ->
+        Option.value (Js.Exn.message error)
+          ~default:(nullable_string_default (Child_process.stderr result))
+    | None -> nullable_string_default (Child_process.stderr result)
+  in
+  {
+    status;
+    stdout = nullable_string_default (Child_process.stdout result);
+    stderr;
+  }
+
+let read_text_file_default path =
+  try Node.Fs.readFileAsUtf8Sync path with _ -> ""
+
+let contains_substring ~needle haystack =
+  let needle_len = String.length needle in
+  let haystack_len = String.length haystack in
+  let rec loop index =
+    if needle_len = 0 then true
+    else if index + needle_len > haystack_len then false
+    else if String.sub haystack index needle_len = needle then true
+    else loop (index + 1)
+  in
+  loop 0
+
+let split_lines text =
+  let len = String.length text in
+  let rec loop start index acc =
+    if index = len then
+      Rrbvec.push_back acc (String.sub text start (index - start))
+    else if text.[index] = '\n' then
+      let acc = Rrbvec.push_back acc (String.sub text start (index - start)) in
+      loop (index + 1) (index + 1) acc
+    else loop start (index + 1) acc
+  in
+  loop 0 0 Rrbvec.empty
+
+let find_session_line text =
+  text |> split_lines
+  |> Rrbvec.find_opt (fun line ->
+      let lower = String.lowercase_ascii line in
+      contains_substring ~needle:"session" lower
+      || contains_substring ~needle:"thread" lower)
+
+let start_process_capture_session_line command args env =
+  let tmp_dir =
+    Fs.mkdtemp_sync (Node.Path.join [| Os.tmpdir (); "logseq-cli-session-" |])
+  in
+  let stdout_path = Node.Path.join [| tmp_dir; "stdout.log" |] in
+  let stderr_path = Node.Path.join [| tmp_dir; "stderr.log" |] in
+  let stdout_fd = Fs.open_sync stdout_path "a" in
+  let stderr_fd = Fs.open_sync stderr_path "a" in
+  let child =
+    try
+      Child_process.spawn command (Rrbvec.to_array args)
+        (Child_process.spawn_options ~detached:true
+           ~stdio:
+             [|
+               Js.Json.string "ignore";
+               Js.Json.number (float_of_int stdout_fd);
+               Js.Json.number (float_of_int stderr_fd);
+             |]
+           ~env:(copy_env env) ~shell:false ())
+    with exn ->
+      (try Fs.close_sync stdout_fd with _ -> ());
+      (try Fs.close_sync stderr_fd with _ -> ());
+      raise_error "spawn" command exn
+  in
+  (try Fs.close_sync stdout_fd with _ -> ());
+  (try Fs.close_sync stderr_fd with _ -> ());
+  let pid =
+    Child_process.pid child |> Js.Nullable.toOption |> Option.value ~default:0
+  in
+  let deadline = Js.Date.now () +. 30_000. in
+  let rec loop last_stdout =
+    let stdout = read_text_file_default stdout_path in
+    match find_session_line stdout with
+    | Some line ->
+        Child_process.unref child;
+        {
+          status = 0;
+          stdout = line;
+          stderr = read_text_file_default stderr_path;
+        }
+    | None when Js.Date.now () >= deadline ->
+        Child_process.unref child;
+        {
+          status = 124;
+          stdout = (if stdout = "" then last_stdout else stdout);
+          stderr =
+            (let stderr = read_text_file_default stderr_path in
+             if String.trim stderr = "" then "timed out waiting for session id"
+             else stderr);
+        }
+    | None when pid <= 0 || not (process_running pid) ->
+        { status = 1; stdout; stderr = read_text_file_default stderr_path }
+    | None ->
+        Atomics_sleep.sleep_ms 50;
+        loop stdout
+  in
+  loop ""
+
+let kill pid signal =
+  try Process.kill pid signal
+  with _ -> raise (Cli_unix_error (ESRCH, "kill", string_of_int pid))
+
+let unquote_double_quoted value =
+  let len = String.length value in
+  if len > 1 && value.[0] = '"' && value.[len - 1] = '"' then
+    String.sub value 1 (len - 2)
+  else value
+
+let windows_start_url_command url =
+  "start \"\" \"" ^ unquote_double_quoted url ^ "\""
+
+let open_url url =
+  try
+    let platform = Node.Process.process##platform in
+    let command, args =
+      match platform with
+      | "darwin" -> ("open", Rrbvec.of_array [| url |])
+      | "linux" -> ("xdg-open", Rrbvec.of_array [| url |])
+      | "win32" ->
+          ( "cmd.exe",
+            Rrbvec.of_array [| "/d"; "/c"; windows_start_url_command url |] )
+      | _ -> raise (Cli_unix_error (EPERM, "open", url))
+    in
+    ignore
+      ((if platform = "win32" then spawn_detached_windows_verbatim
+        else spawn_detached)
+         command args (environment ())
+        : int);
+    true
+  with _ -> false
+
+let write_stdout text = ignore (Process.write Process.stdout text : bool)

cli/lib/platform/node/dune

@@ -0,0 +1,7 @@
+(library
+ (name logseq_cli_platform_node)
+ (implements logseq_cli_platform_spec)
+ (modes melange)
+ (preprocess
+  (pps melange.ppx))
+ (libraries melange-fetch melange.js melange.node rrbvec))

cli/lib/pretty_print.ml

@@ -0,0 +1,68 @@
+external stringify_json_with_space :
+  Js.Json.t -> (_[@mel.as {json|null|json}]) -> int -> string = "stringify"
+[@@mel.scope "JSON"]
+
+let margin = 80
+let spaces count = String.make (max 0 count) ' '
+let vec_of_array = Rrbvec.of_array
+
+let rec flat_value (Melange_edn_melange.Any value as any) =
+  match value with
+  | Melange_edn_melange.Map fields ->
+      vec_of_array fields
+      |> Vec.map (fun (key, value) -> flat_value key ^ " " ^ flat_value value)
+      |> Vec.string_concat ", "
+      |> fun content -> "{" ^ content ^ "}"
+  | Melange_edn_melange.Vector values -> flat_seq "[" "]" (vec_of_array values)
+  | Melange_edn_melange.List values -> flat_seq "(" ")" (vec_of_array values)
+  | Melange_edn_melange.Set values -> flat_seq "#{" "}" (vec_of_array values)
+  | Melange_edn_melange.Tagged (tag, value) ->
+      "#" ^ tag ^ " " ^ flat_value value
+  | _ -> Melange_edn_melange.to_edn_string any
+
+and flat_seq open_ close values =
+  values |> Vec.map flat_value |> Vec.string_concat " " |> fun content ->
+  open_ ^ content ^ close
+
+let rec format_value indent (Melange_edn_melange.Any value as any) =
+  let flat = flat_value any in
+  if indent + String.length flat <= margin then flat
+  else
+    match value with
+    | Melange_edn_melange.Map fields -> format_map indent (vec_of_array fields)
+    | Melange_edn_melange.Vector values ->
+        format_seq indent "[" "]" 1 (vec_of_array values)
+    | Melange_edn_melange.List values ->
+        format_seq indent "(" ")" 1 (vec_of_array values)
+    | Melange_edn_melange.Set values ->
+        format_seq indent "#{" "}" 2 (vec_of_array values)
+    | _ -> flat
+
+and format_map indent fields =
+  if Vec.is_empty fields then "{}"
+  else
+    let entry_indent = indent + 1 in
+    let last_index = Vec.length fields - 1 in
+    fields
+    |> Vec.mapi (fun index (key, value) ->
+        let key = flat_value key in
+        let value_indent = entry_indent + String.length key + 1 in
+        let prefix = if index = 0 then "{" else spaces entry_indent in
+        let suffix = if index = last_index then "" else "," in
+        prefix ^ key ^ " " ^ format_value value_indent value ^ suffix)
+    |> Vec.string_concat "\n"
+    |> fun content -> content ^ "}"
+
+and format_seq indent open_ close open_width values =
+  if Vec.is_empty values then open_ ^ close
+  else
+    let entry_indent = indent + open_width in
+    values
+    |> Vec.mapi (fun index value ->
+        let prefix = if index = 0 then open_ else spaces entry_indent in
+        prefix ^ format_value entry_indent value)
+    |> Vec.string_concat "\n"
+    |> fun content -> content ^ close
+
+let pprint_edn value = format_value 0 value ^ "\n"
+let pprint_json json = stringify_json_with_space json 2

cli/lib/profile_types.ml

@@ -0,0 +1,213 @@
+type span = {
+  stage : string;
+  span_id : int;
+  start_time : Js.Date.t;
+  end_time : Js.Date.t;
+  elapsed_span : float;
+}
+
+type stage_summary = {
+  stage : string;
+  count : int;
+  total_span : float;
+  avg_span : float;
+}
+
+type session = {
+  enabled : bool;
+  start_time : Js.Date.t;
+  mutable spans : span Rrbvec.t;
+  mutable next_span_id : int;
+}
+
+type report = {
+  command : string;
+  status : Cli_primitive.keyword;
+  total_span : float;
+  spans : span Rrbvec.t;
+  stages : stage_summary Rrbvec.t;
+}
+
+let create_session enabled =
+  if enabled then
+    Some
+      { enabled; start_time = Time.now (); spans = Vec.empty; next_span_id = 0 }
+  else None
+
+let next_span_id session =
+  session.next_span_id <- session.next_span_id + 1;
+  session.next_span_id
+
+let record_span (s : session) span = s.spans <- Vec.push_back s.spans span
+
+let record_timed_span session stage span_id start_time end_time =
+  let elapsed_span = Time.non_negative_diff ~start_time ~end_time in
+  record_span session { stage; span_id; start_time; end_time; elapsed_span }
+
+let time session stage f =
+  match session with
+  | None -> f ()
+  | Some session -> (
+      let start_time = Time.now () in
+      let span_id = next_span_id session in
+      let finish () =
+        record_timed_span session stage span_id start_time (Time.now ());
+        Cli_effect.pure ()
+      in
+      try Cli_effect.finally (f ()) finish
+      with exn ->
+        record_timed_span session stage span_id start_time (Time.now ());
+        raise exn)
+
+let summarize_stages spans =
+  let table = Hashtbl.create 16 in
+  let order = ref Vec.empty in
+  Vec.iter
+    (fun (span : span) ->
+      if not (Hashtbl.mem table span.stage) then
+        order := Vec.push_back !order span.stage;
+      let count, total_span =
+        Option.value
+          (Hashtbl.find_opt table span.stage)
+          ~default:(0, Time.zero_span)
+      in
+      Hashtbl.replace table span.stage
+        (count + 1, Time.add_span_value total_span span.elapsed_span))
+    spans;
+  Vec.map
+    (fun stage ->
+      let count, total_span = Hashtbl.find table stage in
+      { stage; count; total_span; avg_span = Time.avg_span total_span count })
+    !order
+
+let report (s : session) ~command ~status =
+  let end_time = Time.now () in
+  let total_span = Time.non_negative_diff ~start_time:s.start_time ~end_time in
+  let spans : span Rrbvec.t = s.spans in
+  let spans =
+    if Vec.exists (fun (span : span) -> span.stage = "cli.total") spans then
+      spans
+    else
+      Vec.push_back spans
+        {
+          stage = "cli.total";
+          span_id = 0;
+          start_time = s.start_time;
+          end_time;
+          elapsed_span = total_span;
+        }
+  in
+  { command; status; total_span; spans; stages = summarize_stages spans }
+
+type stage_node = {
+  label : string;
+  elapsed_span : float;
+  start_time : Js.Date.t;
+  end_time : Js.Date.t;
+  mutable children : stage_node Rrbvec.t;
+}
+
+let span_contains outer inner =
+  Time.compare_time outer.start_time inner.start_time <= 0
+  && Time.compare_time outer.end_time inner.end_time >= 0
+
+let node_of_span (span : span) =
+  {
+    label = span.stage;
+    elapsed_span = span.elapsed_span;
+    start_time = span.start_time;
+    end_time = span.end_time;
+    children = Vec.empty;
+  }
+
+let sort_spans spans =
+  Vec.sort
+    (fun (left : span) (right : span) ->
+      let duration_left = left.elapsed_span in
+      let duration_right = right.elapsed_span in
+      match Time.compare_time left.start_time right.start_time with
+      | 0 -> (
+          match Time.compare_span duration_right duration_left with
+          | 0 -> compare left.span_id right.span_id
+          | value -> value)
+      | value -> value)
+    spans
+
+let build_stage_tree spans =
+  let roots = ref Vec.empty in
+  let stack = ref Vec.empty in
+  let rec trim_stack span items =
+    match Vec.pop_front items with
+    | Some (parent, rest) when not (span_contains parent span) ->
+        trim_stack span rest
+    | _ -> items
+  in
+  Vec.iter
+    (fun span ->
+      let node = node_of_span span in
+      let current_stack = trim_stack node !stack in
+      (match Vec.peek_front_opt current_stack with
+      | Some parent -> parent.children <- Vec.push_back parent.children node
+      | None -> roots := Vec.push_back !roots node);
+      stack := Vec.push_front current_stack node)
+    (sort_spans spans);
+  !roots
+
+let status_text status =
+  let status = Edn_util.keyword_to_string status in
+  if String.length status > 0 && status.[0] = ':' then
+    String.sub status 1 (String.length status - 1)
+  else status
+
+let rec collect_rows prefix rows = function
+  | nodes when Vec.is_empty nodes -> rows
+  | nodes ->
+      let total = Vec.length nodes in
+      Vec.mapi (fun idx node -> (idx, node)) nodes
+      |> Vec.fold_left
+           (fun rows (idx, node) ->
+             let last = idx = total - 1 in
+             let branch =
+               if last then Cli_platform.Symbols.tree_last
+               else Cli_platform.Symbols.tree_middle
+             in
+             let next_prefix =
+               prefix ^ if last then "    " else Cli_platform.Symbols.tree_pipe
+             in
+             let rows =
+               Vec.push_back rows
+                 (Some node.elapsed_span, prefix ^ branch ^ node.label)
+             in
+             collect_rows next_prefix rows node.children)
+           rows
+
+let pad_right value width =
+  let padding = max 0 (width - String.length value) in
+  value ^ String.make padding ' '
+
+let render_lines report =
+  let rows =
+    Vec.of_array
+      [|
+        ( Some report.total_span,
+          "command=" ^ report.command ^ " status=" ^ status_text report.status
+        );
+        (None, "stages");
+      |]
+    |> fun rows -> collect_rows "" rows (build_stage_tree report.spans)
+  in
+  let duration_text =
+    Vec.map
+      (function
+        | Some span, _ -> Int64.to_string (Time.span_to_ms span) ^ "ms"
+        | None, _ -> "")
+      rows
+  in
+  let width =
+    Vec.fold_left
+      (fun width text -> max width (String.length text))
+      0 duration_text
+  in
+  Vec.map2
+    (fun duration (_, text) -> pad_right duration width ^ " " ^ text)
+    duration_text rows

cli/lib/property.ml

@@ -0,0 +1,89 @@
+type key =
+  | Key_ident of Cli_primitive.keyword
+  | Key_id of Cli_primitive.db_id
+  | Key_name of string
+
+type cardinality = One | Many
+
+type kind =
+  | Default
+  | Page
+  | Class
+  | Property
+  | Entity
+  | Node
+  | Date
+  | Url
+  | Checkbox
+  | Number
+  | Template
+  | Other of Cli_primitive.keyword
+
+type schema = {
+  kind : kind option;
+  cardinality : cardinality option;
+  hidden : bool option;
+  public : bool option;
+}
+
+type assignment = { key : key; value : Melange_edn_melange.any }
+
+type update_plan = {
+  update_tags : Selector.tag Rrbvec.t;
+  remove_tags : Selector.tag Rrbvec.t;
+  update_properties : assignment Rrbvec.t;
+  remove_properties : key Rrbvec.t;
+}
+
+let empty_update_plan =
+  {
+    update_tags = Vec.empty;
+    remove_tags = Vec.empty;
+    update_properties = Vec.empty;
+    remove_properties = Vec.empty;
+  }
+
+let parse_key value =
+  match
+    ( Edn_util.as_int64 value,
+      Edn_util.as_keyword_t value,
+      Edn_util.as_string value )
+  with
+  | Some id, _, _ -> Some (Key_id id)
+  | _, Some key, _ -> Some (Key_ident key)
+  | _, _, Some name -> Some (Key_name name)
+  | _ -> None
+
+let kind_of_string = function
+  | "default" -> Some Default
+  | "page" -> Some Page
+  | "class" -> Some Class
+  | "property" -> Some Property
+  | "entity" -> Some Entity
+  | "node" -> Some Node
+  | "date" -> Some Date
+  | "url" -> Some Url
+  | "checkbox" -> Some Checkbox
+  | "number" -> Some Number
+  | "template" -> Some Template
+  | "" -> None
+  | s -> Some (Other (Edn_util.keyword_t s))
+
+let string_of_kind = function
+  | Default -> "default"
+  | Page -> "page"
+  | Class -> "class"
+  | Property -> "property"
+  | Entity -> "entity"
+  | Node -> "node"
+  | Date -> "date"
+  | Url -> "url"
+  | Checkbox -> "checkbox"
+  | Number -> "number"
+  | Template -> "template"
+  | Other k -> Edn_util.keyword_to_string k
+
+let cardinality_of_string = function
+  | "one" -> Some One
+  | "many" -> Some Many
+  | _ -> None

cli/lib/query.ml

@@ -0,0 +1,952 @@
+type input_spec = {
+  name : string;
+  optional : bool;
+  default : Melange_edn_melange.any option;
+}
+
+type source = Built_in | Custom
+
+type query_entry = {
+  name : string;
+  source : source;
+  doc : string option;
+  inputs : input_spec Rrbvec.t;
+  query : Melange_edn_melange.any;
+}
+
+type opts = {
+  query_edn : string option;
+  name : string option;
+  inputs_edn : string option;
+}
+
+type parsed = Parsed_run of opts | Parsed_list
+
+type action =
+  | Run of {
+      repo : Cli_primitive.repo;
+      graph : Cli_primitive.graph;
+      query : Melange_edn_melange.any;
+      inputs : Melange_edn_melange.any Rrbvec.t;
+      name : string option;
+    }
+  | List
+
+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 normalize_query_name value =
+  let value = String.trim value in
+  if value = "" then None
+  else if String.length value > 0 && value.[0] = ':' then
+    Some (String.sub value 1 (String.length value - 1))
+  else Some value
+
+let parsed_edn text =
+  match edn_value_of_string ~label:"built-in query" text with
+  | Ok value -> value
+  | Error err -> failwith err.message
+
+let kw value = Edn_util.keyword value
+let sym value = Edn_util.symbol value
+let in_sym value = Melange_edn_melange.symbol value
+let vector_vec values = Edn_util.vector_vec values
+let vector_t_vec values = Edn_util.vector_t_vec values
+let vector_t values = vector_t_vec values
+let list_vec values = Edn_util.list_vec values
+let list_t_vec values = Edn_util.list_t_vec values
+let list_t values = list_t_vec values
+let where_v values = Cli_primitive.V (vector_t values)
+let where_l values = Cli_primitive.L (list_t values)
+
+let query_value query =
+  Edn_util.any (Cli_primitive.datascript_query_to_edn query)
+
+let input ?default name =
+  { name; optional = String.length name > 0 && name.[0] = '?'; default }
+
+let built_in_queries =
+  Vec.of_array
+    [|
+      {
+        name = "list-priority";
+        source = Built_in;
+        doc = Some "List closed values for the Priority property.";
+        inputs = Vec.empty;
+        query =
+          query_value
+            (Cli_primitive.make_datascript_query
+               ~find:
+                 (Vec.of_array
+                    [|
+                      vector_vec
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "pull";
+                                    sym "?value";
+                                    vector_vec
+                                      (Vec.of_array
+                                         [|
+                                           kw "db/id";
+                                           kw "db/ident";
+                                           kw "block/order";
+                                         |]);
+                                  |]);
+                             sym "...";
+                           |]);
+                    |])
+               ~where:
+                 (Vec.of_array
+                    [|
+                      where_v
+                        (Vec.of_array
+                           [|
+                             sym "?property";
+                             kw "db/ident";
+                             kw "logseq.property/priority";
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             sym "?value";
+                             kw "block/closed-value-property";
+                             sym "?property";
+                           |]);
+                    |])
+               ());
+      };
+      {
+        name = "list-status";
+        source = Built_in;
+        doc = Some "List closed values for the Status property.";
+        inputs = Vec.empty;
+        query =
+          query_value
+            (Cli_primitive.make_datascript_query
+               ~find:
+                 (Vec.of_array
+                    [|
+                      vector_vec
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "pull";
+                                    sym "?value";
+                                    vector_vec
+                                      (Vec.of_array
+                                         [|
+                                           kw "db/id";
+                                           kw "db/ident";
+                                           kw "block/order";
+                                         |]);
+                                  |]);
+                             sym "...";
+                           |]);
+                    |])
+               ~where:
+                 (Vec.of_array
+                    [|
+                      where_v
+                        (Vec.of_array
+                           [|
+                             sym "?property";
+                             kw "db/ident";
+                             kw "logseq.property/status";
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             sym "?value";
+                             kw "block/closed-value-property";
+                             sym "?property";
+                           |]);
+                    |])
+               ());
+      };
+      {
+        name = "recent-updated";
+        source = Built_in;
+        doc = Some "Find entities updated within recent-days.";
+        inputs = Vec.of_array [| input "recent-days"; input "?now-ms" |];
+        query =
+          query_value
+            (Cli_primitive.make_datascript_query
+               ~find:
+                 (Vec.of_array
+                    [|
+                      vector_vec
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "pull";
+                                    sym "?e";
+                                    vector_vec
+                                      (Vec.of_array
+                                         [|
+                                           kw "db/id";
+                                           kw "block/title";
+                                           kw "block/updated-at";
+                                         |]);
+                                  |]);
+                             sym "...";
+                           |]);
+                    |])
+               ~in_:
+                 (Vec.of_array
+                    [| in_sym "$"; in_sym "?recent-days"; in_sym "?now-ms" |])
+               ~where:
+                 (Vec.of_array
+                    [|
+                      where_v
+                        (Vec.of_array
+                           [|
+                             sym "?e"; kw "block/updated-at"; sym "?updated-at";
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "missing?";
+                                    sym "$";
+                                    sym "?e";
+                                    kw "logseq.property/built-in?";
+                                  |]);
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "*";
+                                    sym "?recent-days";
+                                    Edn_util.int 86400000;
+                                  |]);
+                             sym "?recent-days-ms";
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "-";
+                                    sym "?now-ms";
+                                    sym "?recent-days-ms";
+                                  |]);
+                             sym "?days-ago";
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym ">="; sym "?updated-at"; sym "?days-ago";
+                                  |]);
+                           |]);
+                    |])
+               ());
+      };
+      {
+        name = "task-search";
+        source = Built_in;
+        doc =
+          Some
+            "Find tasks by status, optional title substring, optional \
+             recent-days.";
+        inputs =
+          Vec.of_array
+            [|
+              input "search-status";
+              input ~default:(Edn_util.string "") "?search-title";
+              input ~default:(Edn_util.int 0) "?recent-days";
+              input "?now-ms";
+            |];
+        query =
+          query_value
+            (Cli_primitive.make_datascript_query
+               ~find:
+                 (Vec.of_array
+                    [|
+                      vector_vec
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "pull";
+                                    sym "?e";
+                                    vector_vec
+                                      (Vec.of_array
+                                         [|
+                                           kw "db/id";
+                                           kw "block/title";
+                                           kw "block/updated-at";
+                                         |]);
+                                  |]);
+                             sym "...";
+                           |]);
+                    |])
+               ~in_:
+                 (Vec.of_array
+                    [|
+                      in_sym "$";
+                      in_sym "?search-status";
+                      in_sym "?search-title";
+                      in_sym "?recent-days";
+                      in_sym "?now-ms";
+                    |])
+               ~where:
+                 (Vec.of_array
+                    [|
+                      where_v
+                        (Vec.of_array
+                           [| sym "?e"; kw "block/title"; sym "?title" |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             sym "?e";
+                             kw "logseq.property/status";
+                             sym "?status";
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             sym "?status"; kw "db/ident"; sym "?status-ident";
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "=";
+                                    sym "?status-ident";
+                                    sym "?search-status";
+                                  |]);
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "clojure.string/lower-case";
+                                    sym "?title";
+                                  |]);
+                             sym "?title-lower-case";
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [| sym "str"; sym "?search-title" |]);
+                             sym "?search-title-string";
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "clojure.string/lower-case";
+                                    sym "?search-title-string";
+                                  |]);
+                             sym "?search-title-lower-case";
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "clojure.string/includes?";
+                                    sym "?title-lower-case";
+                                    sym "?search-title-lower-case";
+                                  |]);
+                           |]);
+                      where_v
+                        (Vec.of_array
+                           [|
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "get-else";
+                                    sym "$";
+                                    sym "?e";
+                                    kw "block/updated-at";
+                                    Edn_util.int 0;
+                                  |]);
+                             sym "?updated-at";
+                           |]);
+                      where_l
+                        (Vec.of_array
+                           [|
+                             sym "or-join";
+                             vector_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "?recent-days";
+                                    sym "?updated-at";
+                                    sym "?now-ms";
+                                    sym "?days-ago";
+                                  |]);
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "and";
+                                    vector_vec
+                                      (Vec.of_array
+                                         [|
+                                           list_vec
+                                             (Vec.of_array
+                                                [|
+                                                  sym "nil?"; sym "?recent-days";
+                                                |]);
+                                         |]);
+                                    vector_vec
+                                      (Vec.of_array
+                                         [|
+                                           list_vec
+                                             (Vec.of_array
+                                                [|
+                                                  sym "identity"; Edn_util.int 0;
+                                                |]);
+                                           sym "?days-ago";
+                                         |]);
+                                  |]);
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "and";
+                                    vector_vec
+                                      (Vec.of_array
+                                         [|
+                                           list_vec
+                                             (Vec.of_array
+                                                [|
+                                                  sym "<=";
+                                                  sym "?recent-days";
+                                                  Edn_util.int 0;
+                                                |]);
+                                         |]);
+                                    vector_vec
+                                      (Vec.of_array
+                                         [|
+                                           list_vec
+                                             (Vec.of_array
+                                                [|
+                                                  sym "identity"; Edn_util.int 0;
+                                                |]);
+                                           sym "?days-ago";
+                                         |]);
+                                  |]);
+                             list_vec
+                               (Vec.of_array
+                                  [|
+                                    sym "and";
+                                    vector_vec
+                                      (Vec.of_array
+                                         [|
+                                           list_vec
+                                             (Vec.of_array
+                                                [|
+                                                  sym "*";
+                                                  sym "?recent-days";
+                                                  Edn_util.int 86400000;
+                                                |]);
+                                           sym "?recent-days-ms";
+                                         |]);
+                                    vector_vec
+                                      (Vec.of_array
+                                         [|
+                                           list_vec
+                                             (Vec.of_array
+                                                [|
+                                                  sym "-";
+                                                  sym "?now-ms";
+                                                  sym "?recent-days-ms";
+                                                |]);
+                                           sym "?days-ago";
+                                         |]);
+                                    vector_vec
+                                      (Vec.of_array
+                                         [|
+                                           list_vec
+                                             (Vec.of_array
+                                                [|
+                                                  sym ">=";
+                                                  sym "?updated-at";
+                                                  sym "?days-ago";
+                                                |]);
+                                         |]);
+                                  |]);
+                           |]);
+                    |])
+               ());
+      };
+    |]
+  |> Vec.sort (fun (a : query_entry) (b : query_entry) ->
+      String.compare a.name b.name)
+
+let db_query_dsl_rules =
+  parsed_edn
+    {|[
+      [(parent ?p ?c) [?c :block/parent ?p]]
+      [(parent ?p ?c) [?t :block/parent ?p] (parent ?t ?c)]
+      [(class-extends ?p ?c) [?c :logseq.property.class/extends ?p]]
+      [(class-extends ?p ?c) [?t :logseq.property.class/extends ?p] (class-extends ?t ?c)]
+      [(alias ?e2 ?e1) [?e2 :block/alias ?e1]]
+      [(alias ?e2 ?e1) [?e1 :block/alias ?e2]]
+      [(self-ref ?b ?ref) [?b :block/refs ?ref]]
+      [(has-ref ?b ?r) [?b :block/refs ?r]]
+      [(has-ref ?b ?r) (parent ?p ?b) [?p :block/refs ?r]]
+      [(page-ref ?b ?ref) (has-ref ?b ?ref)]
+      [(block-content ?b ?query) [?b :block/title ?content] [(clojure.string/includes? ?content ?query)]]
+      [(page ?b ?page-name) [?b :block/page ?bp] [?bp :block/name ?page-name]]
+      [(between ?b ?start ?end) [?b :block/page ?p] [?p :block/tags :logseq.class/Journal] [?p :block/journal-day ?d] [(>= ?d ?start)] [(<= ?d ?end)]]
+      [(ref->val ?pv ?val) [?pv :block/title ?val]]
+      [(ref->val ?pv ?val) [?pv :logseq.property/value ?val]]
+      [(property-missing-value ?b ?prop-e ?default-p ?default-v) [?t :logseq.property.class/properties ?prop-e] [?prop-e :db/ident ?prop] (object-has-class-property? ?b ?prop) [(get-else $ ?b ?prop "N/A") ?prop-v] [(= ?prop-v "N/A")] [?prop-e ?default-p ?default-v]]
+      [(scalar-property-value ?b ?prop-e ?val) [?prop-e :db/ident ?prop] [?b ?prop ?val]]
+      [(scalar-property-value-with-default ?b ?prop-e ?val) (scalar-property-value ?b ?prop-e ?val)]
+      [(scalar-property-value-with-default ?b ?prop-e ?val) (property-missing-value ?b ?prop-e :logseq.property/scalar-default-value ?val)]
+      [(ref-property-value ?b ?prop-e ?val) [?prop-e :db/ident ?prop] [?b ?prop ?pv] (ref->val ?pv ?val)]
+      [(ref-property-value-with-default ?b ?prop-e ?val) (ref-property-value ?b ?prop-e ?val)]
+      [(ref-property-value-with-default ?b ?prop-e ?val) (property-missing-value ?b ?prop-e :logseq.property/default-value ?pv) (ref->val ?pv ?val)]
+      [(object-has-class-property? ?b ?prop) [?prop-e :db/ident ?prop] [?t :logseq.property.class/properties ?prop-e] [?b :block/tags ?tc] (or [(= ?t ?tc)] (class-extends ?t ?tc))]
+      [(has-property-or-object-property? ?b ?prop) [?prop-e :db/ident ?prop] (or [?b ?prop _] (object-has-class-property? ?b ?prop))]
+      [(has-simple-query-property ?b ?prop) [?prop-e :db/ident ?prop] [?prop-e :block/tags :logseq.class/Property] (has-property-or-object-property? ?b ?prop) (or [(missing? $ ?prop-e :logseq.property/public?)] [?prop-e :logseq.property/public? true])]
+      [(has-private-simple-query-property ?b ?prop) [?prop-e :db/ident ?prop] [?prop-e :block/tags :logseq.class/Property] (has-property-or-object-property? ?b ?prop)]
+      [(has-property ?b ?prop) [?b ?prop _] [?prop-e :db/ident ?prop] [?prop-e :block/tags :logseq.class/Property] (or [(missing? $ ?prop-e :logseq.property/public?)] [?prop-e :logseq.property/public? true])]
+      [(scalar-property ?b ?prop ?val) [?prop-e :db/ident ?prop] (scalar-property-value ?b ?prop-e ?val) (or [(missing? $ ?prop-e :logseq.property/public?)] [?prop-e :logseq.property/public? true])]
+      [(scalar-property-with-default ?b ?prop ?val) [?prop-e :db/ident ?prop] (scalar-property-value-with-default ?b ?prop-e ?val) (or [(missing? $ ?prop-e :logseq.property/public?)] [?prop-e :logseq.property/public? true])]
+      [(ref-property ?b ?prop ?val) [?prop-e :db/ident ?prop] (ref-property-value ?b ?prop-e ?val) (or [(missing? $ ?prop-e :logseq.property/public?)] [?prop-e :logseq.property/public? true])]
+      [(ref-property-with-default ?b ?prop ?val) [?prop-e :db/ident ?prop] (ref-property-value-with-default ?b ?prop-e ?val) (or [(missing? $ ?prop-e :logseq.property/public?)] [?prop-e :logseq.property/public? true])]
+      [(private-scalar-property ?b ?prop ?val) [?prop-e :db/ident ?prop] [?prop-e :block/tags :logseq.class/Property] (scalar-property-value ?b ?prop-e ?val)]
+      [(private-scalar-property-with-default ?b ?prop ?val) [?prop-e :db/ident ?prop] [?prop-e :block/tags :logseq.class/Property] (scalar-property-value-with-default ?b ?prop-e ?val)]
+      [(private-ref-property ?b ?prop ?val) [?prop-e :db/ident ?prop] [?prop-e :block/tags :logseq.class/Property] (ref-property-value ?b ?prop-e ?val)]
+      [(private-ref-property-with-default ?b ?prop ?val) [?prop-e :db/ident ?prop] [?prop-e :block/tags :logseq.class/Property] (ref-property-value-with-default ?b ?prop-e ?val)]
+      [(property ?b ?prop ?val) [?prop-e :db/ident ?prop] [?prop-e :block/tags :logseq.class/Property] (or [(missing? $ ?prop-e :logseq.property/public?)] [?prop-e :logseq.property/public? true]) [?b ?prop ?pv] (or (and [(missing? $ ?prop-e :db/valueType)] [?b ?prop ?val]) (and [?prop-e :db/valueType :db.type/ref] (or [?pv :block/title ?val] [?pv :logseq.property/value ?val])))]
+      [(tag-spec->tag ?tag ?spec) [(number? ?spec)] [(identity ?spec) ?tag]]
+      [(tag-spec->tag ?tag ?spec) [?tag :block/title ?spec]]
+      [(tag-spec->tag ?tag ?spec) [?tag :db/ident ?spec]]
+      [(tags ?b ?tags) [(identity ?tags) [?spec ...]] (tag-spec->tag ?tag ?spec) [?b :block/tags ?tc] (or [(= ?tag ?tc)] (class-extends ?tag ?tc)) [(missing? $ ?b :block/link)]]
+      [(task ?b ?statuses) (ref-property-with-default ?b :logseq.property/status ?val) [(contains? ?statuses ?val)]]
+      [(priority ?b ?priorities) (ref-property-with-default ?b :logseq.property/priority ?priority) [(contains? ?priorities ?priority)]]
+    ]|}
+
+let trim_non_empty value =
+  let value = String.trim value in
+  if value = "" then None else Some value
+
+let strip_leading_colon value =
+  if String.length value > 0 && value.[0] = ':' then
+    String.sub value 1 (String.length value - 1)
+  else value
+
+let query_name_of_value value =
+  match (Edn_util.as_string value, Edn_util.as_keyword value) with
+  | Some value, _ | _, Some value -> trim_non_empty (strip_leading_colon value)
+  | _ ->
+      trim_non_empty
+        (Melange_edn_melange.to_edn_string value |> strip_leading_colon)
+
+let custom_query_input value =
+  match (Edn_util.as_string value, Edn_util.as_keyword value) with
+  | Some value, _ | _, Some value ->
+      Option.map
+        (fun name -> input name)
+        (trim_non_empty (strip_leading_colon value))
+  | _ -> (
+      match Edn_util.as_map value with
+      | Some _ -> (
+          match Option.bind (Edn_util.get value "name") query_name_of_value with
+          | None -> None
+          | Some name ->
+              Some
+                {
+                  name;
+                  optional = String.length name > 0 && name.[0] = '?';
+                  default = Edn_util.get value "default";
+                })
+      | None -> None)
+
+let custom_query_inputs = function
+  | Some value -> (
+      match Edn_util.as_seq value with
+      | Some values -> Vec.filter_map custom_query_input values
+      | _ -> Vec.empty)
+  | _ -> Vec.empty
+
+let custom_query_entry name source spec =
+  let query, doc, inputs =
+    match spec with
+    | spec -> (
+        match (Edn_util.as_vector spec, Edn_util.as_map spec) with
+        | Some _, _ -> (Some spec, None, Vec.empty)
+        | _, Some _ ->
+            ( Edn_util.get spec "query",
+              Edn_util.get_string spec "doc",
+              custom_query_inputs (Edn_util.get spec "inputs") )
+        | _ -> (None, None, Vec.empty))
+  in
+  match (query_name_of_value name, query) with
+  | Some name, Some query -> Some { name; source; doc; inputs; query }
+  | _ -> None
+
+let custom_queries config =
+  match
+    Option.bind config.Cli_config.raw_file_config (fun value ->
+        Edn_util.get value "custom-queries")
+  with
+  | Some value -> (
+      match Edn_util.as_map value with
+      | Some fields ->
+          Vec.filter_map
+            (fun (name, spec) -> custom_query_entry name Custom spec)
+            fields
+      | _ -> Vec.empty)
+  | _ -> Vec.empty
+
+let merge_queries entries =
+  let upsert acc (entry : query_entry) =
+    acc
+    |> Vec.filter (fun (existing : query_entry) -> existing.name <> entry.name)
+    |> fun acc -> Vec.push_back acc entry
+  in
+  entries
+  |> Vec.fold_left upsert Vec.empty
+  |> Vec.sort (fun (a : query_entry) (b : query_entry) ->
+      String.compare a.name b.name)
+
+let list_queries config : query_entry Rrbvec.t =
+  merge_queries (Vec.append built_in_queries (custom_queries config))
+
+let find_query config name =
+  Vec.find_opt
+    (fun (entry : query_entry) -> entry.name = name)
+    (list_queries config)
+
+let rec contains_db_id_datom_clause value =
+  match (Edn_util.as_vector value, Edn_util.as_list value) with
+  | Some values, _
+    when Vec.length values >= 2
+         && Edn_util.as_keyword (Vec.nth values 1) = Some "db/id" ->
+      true
+  | Some values, _ | _, Some values ->
+      Vec.exists contains_db_id_datom_clause values
+  | _ -> false
+
+let validate_query query =
+  match Edn_util.as_vector query with
+  | Some values ->
+      let rec after_where values =
+        match Vec.pop_front values with
+        | None -> Vec.empty
+        | Some (keyword, clauses)
+          when Edn_util.as_keyword keyword = Some "where" ->
+            clauses
+        | Some (_, rest) -> after_where rest
+      in
+      if Vec.exists contains_db_id_datom_clause (after_where values) then
+        Error
+          (Error.make Error.Invalid_query
+             "invalid query: :db/id cannot be used as a datom attribute in \
+              :where clauses. Bind entity ids through :in and --inputs.")
+      else Ok query
+  | _ -> Error (Error.invalid_options "query must be a vector")
+
+let current_epoch_ms () = Time.time_to_epoch_ms (Time.now ())
+
+let normalize_task_search_inputs (entry : query_entry option) inputs =
+  match entry with
+  | Some { name = "task-search"; _ } -> (
+      match Vec.pop_front inputs with
+      | Some (status_value, rest)
+        when Option.is_some (Edn_util.as_string status_value) ->
+          let status =
+            Option.value (Edn_util.as_string status_value) ~default:""
+          in
+          let status = String.trim status |> String.lowercase_ascii in
+          if status = "" then inputs
+          else
+            Vec.push_front rest
+              (Edn_util.keyword ("logseq.property/status." ^ status))
+      | _ -> inputs)
+  | _ -> inputs
+
+let validate_recent_updated_inputs (entry : query_entry option) inputs =
+  match (entry, Vec.peek_front_opt inputs) with
+  | ( Some { name = "recent-updated"; source = Built_in; _ },
+      Some recent_days_value )
+    when Option.value (Edn_util.as_int recent_days_value) ~default:0 > 0 ->
+      Ok inputs
+  | Some { name = "recent-updated"; source = Built_in; _ }, _ ->
+      Error (Error.invalid_options "recent-days must be a positive integer")
+  | _ -> Ok inputs
+
+let normalize_inputs entry inputs =
+  match entry with
+  | None -> Ok inputs
+  | Some entry ->
+      let required =
+        Vec.length (Vec.filter (fun spec -> not spec.optional) entry.inputs)
+      in
+      if Vec.length inputs < required then
+        Error (Error.invalid_options "inputs missing required values")
+      else
+        let rec fill acc specs values =
+          match Vec.pop_front specs with
+          | Some (_spec, rest_specs) when not (Vec.is_empty values) ->
+              let value, rest_values =
+                match Vec.pop_front values with
+                | Some pair -> pair
+                | None -> failwith "non-empty vector must have a front value"
+              in
+              fill (Vec.push_back acc value) rest_specs rest_values
+          | None -> Vec.append acc values
+          | Some (spec, rest) ->
+              let default =
+                match spec.default with
+                | Some value when Edn_util.as_keyword value = Some "now-ms" ->
+                    Edn_util.int64 (current_epoch_ms ())
+                | Some value -> value
+                | None when spec.name = "?now-ms" ->
+                    Edn_util.int64 (current_epoch_ms ())
+                | None -> Edn_util.nil
+              in
+              fill (Vec.push_back acc default) rest Vec.empty
+        in
+        fill Vec.empty entry.inputs inputs
+        |> normalize_task_search_inputs (Some entry)
+        |> validate_recent_updated_inputs (Some entry)
+
+let command_id = function
+  | Parsed_run _ -> Command_id.Query
+  | Parsed_list -> Query_list
+
+let validate_parsed _ = Ok ()
+
+let symbol_is name = function
+  | Melange_edn_melange.Any (Melange_edn_melange.Symbol value) -> value = name
+  | _ -> false
+
+let query_in_ends_with_percent query =
+  match Edn_util.as_vector query with
+  | Some values -> (
+      let rec find_in values =
+        match Vec.pop_front values with
+        | None -> Vec.empty
+        | Some (keyword, rest) when Edn_util.as_keyword keyword = Some "in" ->
+            collect_in Vec.empty rest
+        | Some (_, rest) -> find_in rest
+      and collect_in acc values =
+        match Vec.pop_front values with
+        | None -> acc
+        | Some (keyword, _) when Option.is_some (Edn_util.as_keyword keyword) ->
+            acc
+        | Some (value, rest) -> collect_in (Vec.push_back acc value) rest
+      in
+      match find_in values with
+      | values when not (Vec.is_empty values) ->
+          symbol_is "%" (Vec.nth values (Vec.length values - 1))
+      | _ -> false)
+  | _ -> false
+
+let query_args query inputs =
+  let args = Vec.push_front inputs query in
+  if query_in_ends_with_percent query then Vec.push_back args db_query_dsl_rules
+  else args
+
+let build ?registry:_ config _globals parsed =
+  match parsed with
+  | Parsed_list -> Ok List
+  | Parsed_run opts -> (
+      match config.Cli_config.repo with
+      | None -> Error (Error.missing_repo "repo is required for query")
+      | Some repo ->
+          let query_text = Option.bind opts.query_edn Cli_primitive.non_empty in
+          let query_name = Option.bind opts.name normalize_query_name in
+          if Option.is_some query_text && Option.is_some query_name then
+            Error
+              (Error.invalid_options "use either --query or --name, not both")
+          else if Option.is_none query_text && Option.is_none query_name then
+            Error (Error.make Error.Missing_query "query is required")
+          else
+            let query_result, entry =
+              match (query_text, query_name) with
+              | Some text, _ -> (edn_value_of_string ~label:"query" text, None)
+              | None, Some name -> (
+                  match find_query config name with
+                  | Some entry -> (Ok entry.query, Some entry)
+                  | None ->
+                      ( Error
+                          (Error.make Error.Unknown_query
+                             ("unknown query: " ^ name)),
+                        None ))
+              | _ ->
+                  ( Error (Error.make Error.Missing_query "query is required"),
+                    None )
+            in
+            Error.bind query_result (fun query ->
+                Error.bind (validate_query query) (fun query ->
+                    let inputs_result =
+                      match
+                        Option.bind opts.inputs_edn Cli_primitive.non_empty
+                      with
+                      | None -> Ok Vec.empty
+                      | Some text -> (
+                          match edn_value_of_string ~label:"inputs" text with
+                          | Ok value -> (
+                              match Edn_util.as_vector value with
+                              | Some inputs -> Ok inputs
+                              | _ ->
+                                  Error
+                                    (Error.invalid_options
+                                       "inputs must be a vector"))
+                          | Error _ as err -> err)
+                    in
+                    Error.bind inputs_result (fun inputs ->
+                        Error.bind (normalize_inputs entry inputs)
+                          (fun inputs ->
+                            Ok
+                              (Run
+                                 {
+                                   repo;
+                                   graph = Cli_config.repo_to_graph repo;
+                                   query;
+                                   inputs;
+                                   name = query_name;
+                                 }))))))
+
+let source_value = function
+  | Built_in -> Edn_util.string "built-in"
+  | Custom -> Edn_util.string "custom"
+
+let input_value (input : input_spec) =
+  let fields =
+    Vec.of_array
+      [|
+        (Edn_util.keyword "name", Edn_util.string input.name);
+        (Edn_util.keyword "optional", Edn_util.bool input.optional);
+      |]
+    |> fun fields ->
+    match input.default with
+    | Some value -> Vec.push_back fields (Edn_util.keyword "default", value)
+    | None -> fields
+  in
+  Edn_util.map_vec fields
+
+let hide_internal_inputs (entry : query_entry) : query_entry =
+  {
+    entry with
+    inputs =
+      Vec.filter
+        (fun (input : input_spec) -> input.name <> "?now-ms")
+        entry.inputs;
+  }
+
+let query_entry_value (entry : query_entry) =
+  let entry = hide_internal_inputs entry in
+  Edn_util.map_vec
+    (Vec.of_array
+       [|
+         (Edn_util.keyword "name", Edn_util.string entry.name);
+         (Edn_util.keyword "source", source_value entry.source);
+         ( Edn_util.keyword "doc",
+           match entry.doc with
+           | Some doc -> Edn_util.string doc
+           | None -> Edn_util.nil );
+         ( Edn_util.keyword "inputs",
+           Edn_util.vector_vec (entry.inputs |> Vec.map input_value) );
+         (Edn_util.keyword "query", entry.query);
+       |])
+
+let execute_with_mode action config mode =
+  let open Cli_effect in
+  match action with
+  | List ->
+      pure
+        (Cli_result.ok ~command:Command_id.Query_list mode
+           (Raw
+              (Edn_util.map_vec
+                 (Vec.of_array
+                    [|
+                      ( Edn_util.keyword "queries",
+                        Edn_util.vector_vec
+                          (list_queries config |> Vec.map query_entry_value) );
+                    |]))))
+  | Run { repo; query; inputs; _ } ->
+      bind (Server_runtime.ensure_server config repo ~create_empty_db:false)
+        (function
+        | Error err ->
+            pure (Output_mode.error ~command:Command_id.Query mode err)
+        | Ok invoke_config ->
+            bind
+              (Transport.thread_api_q invoke_config ~repo
+                 ~query:(Edn_util.vector_t_vec (query_args query inputs)))
+              (fun value ->
+                pure
+                  (Cli_result.ok ~command:Command_id.Query mode
+                     (Query_result
+                        (Edn_util.map_vec
+                           (Vec.of_array
+                              [| (Edn_util.keyword "result", value) |]))))))
+
+let meta ?(examples = Vec.empty) id doc =
+  {
+    Command_registry.id;
+    path = Command_id.to_path id;
+    doc;
+    long_doc = None;
+    examples;
+    options = Vec.empty;
+    category = Command_registry.Graph_inspect_and_edit;
+    requires_graph = Command_id.requires_graph id;
+    requires_auth = Command_id.requires_auth id;
+    write_command = Command_id.is_write id;
+    human_table_headers_order = Vec.empty;
+  }
+
+let metadata () =
+  Vec.of_array
+    [|
+      meta
+        ~examples:
+          (Vec.of_array
+             [|
+               "logseq query --graph my-graph --name recent-updated --inputs \
+                '[30]'";
+               "logseq query --graph my-graph --name task-search --inputs \
+                '[:logseq.property/status.done \"daily\"]'";
+               "logseq query --graph my-graph --query '[:find [?e ...] :where \
+                [?e :block/name]]'";
+             |])
+        Command_id.Query "Run a Datascript query";
+      meta
+        ~examples:
+          (Vec.of_array
+             [|
+               "logseq query list --graph my-graph";
+               "logseq query list --graph my-graph --output edn";
+             |])
+        Query_list "List available queries";
+    |]
+
+let execute action config =
+  let (Output.Mode.Packed mode) = Output_mode.for_config config in
+  execute_with_mode action config mode

cli/lib/remove.ml

@@ -0,0 +1,743 @@
+type block_opts = { id_raw : string option; uuid : Cli_primitive.uuid option }
+type page_opts = { id : Cli_primitive.db_id option; page : string option }
+
+type named_entity_opts = {
+  id : Cli_primitive.db_id option;
+  name : string option;
+}
+
+type parsed =
+  | Parsed_block of block_opts
+  | Parsed_page of page_opts
+  | Parsed_tag of named_entity_opts
+  | Parsed_property of named_entity_opts
+
+type action =
+  | Remove_block of {
+      repo : Cli_primitive.repo;
+      graph : Cli_primitive.graph;
+      id : Cli_primitive.db_id option;
+      ids : Cli_primitive.db_id Rrbvec.t;
+      multi_id : bool;
+      uuid : Cli_primitive.uuid option;
+    }
+  | Remove_page of {
+      repo : Cli_primitive.repo;
+      graph : Cli_primitive.graph;
+      id : Cli_primitive.db_id option;
+      page : string option;
+    }
+  | Remove_tag of {
+      repo : Cli_primitive.repo;
+      graph : Cli_primitive.graph;
+      id : Cli_primitive.db_id option;
+      name : string option;
+    }
+  | Remove_property of {
+      repo : Cli_primitive.repo;
+      graph : Cli_primitive.graph;
+      id : Cli_primitive.db_id option;
+      name : string option;
+    }
+
+let command_id = function
+  | Parsed_block _ -> Command_id.Remove_block
+  | Parsed_page _ -> Remove_page
+  | Parsed_tag _ -> Remove_tag
+  | Parsed_property _ -> Remove_property
+
+let count_some values =
+  Vec.fold_left
+    (fun count -> function Some _ -> count + 1 | None -> count)
+    0 values
+
+let invalid_options = function
+  | Parsed_block opts
+    when count_some (Vec.of_array [| opts.id_raw; opts.uuid |]) > 1 ->
+      Some "only one of --id or --uuid is allowed"
+  | Parsed_page opts
+    when count_some
+           (Vec.of_array [| Option.map Int64.to_string opts.id; opts.page |])
+         > 1 ->
+      Some "only one of --id or --page is allowed"
+  | Parsed_page { page = Some page; _ } when String.trim page = "" ->
+      Some "page must be non-empty"
+  | (Parsed_tag opts | Parsed_property opts)
+    when count_some
+           (Vec.of_array [| Option.map Int64.to_string opts.id; opts.name |])
+         > 1 ->
+      Some "only one of --id or --name is allowed"
+  | Parsed_tag { name = Some name; _ }
+  | Parsed_property { name = Some name; _ }
+    when String.trim name = "" ->
+      Some "name must be non-empty"
+  | _ -> None
+
+let validate_parsed parsed =
+  match invalid_options parsed with
+  | Some message -> Error (Error.invalid_options message)
+  | None -> Ok ()
+
+let repo_or_error config =
+  match config.Cli_config.repo with
+  | Some repo -> Ok (repo, Cli_config.repo_to_graph repo)
+  | None -> Error (Error.missing_repo "repo is required for remove")
+
+let build_block repo graph (opts : block_opts) =
+  match (opts.id_raw, opts.uuid) with
+  | None, None -> Error (Error.make Error.Missing_target "block is required")
+  | Some id_raw, None -> (
+      match Id_parse.parse_id_string id_raw with
+      | Ok ids ->
+          Ok
+            (Remove_block
+               {
+                 repo;
+                 graph;
+                 id = Id_parse.to_single ids;
+                 ids = ids.ids;
+                 multi_id = ids.multi;
+                 uuid = None;
+               })
+      | Error err -> Error err)
+  | None, Some uuid ->
+      let uuid = String.trim uuid in
+      if Cli_primitive.is_uuid_string uuid then
+        Ok
+          (Remove_block
+             {
+               repo;
+               graph;
+               id = None;
+               ids = Vec.empty;
+               multi_id = false;
+               uuid = Some uuid;
+             })
+      else
+        Error (Error.invalid_options "Option uuid must be a valid UUID string")
+  | Some _, Some _ ->
+      Error (Error.invalid_options "only one of --id or --uuid is allowed")
+
+let build_page repo graph (opts : page_opts) =
+  match (opts.id, Option.map String.trim opts.page) with
+  | None, None ->
+      Error (Error.make Error.Missing_page_name "page name or id is required")
+  | Some id, None -> Ok (Remove_page { repo; graph; id = Some id; page = None })
+  | None, Some page when page <> "" ->
+      Ok (Remove_page { repo; graph; id = None; page = Some page })
+  | None, Some _ -> Error (Error.invalid_options "page must be non-empty")
+  | Some _, Some _ ->
+      Error (Error.invalid_options "only one of --id or --page is allowed")
+
+let build_named make repo graph (opts : named_entity_opts) =
+  match (opts.id, Option.map String.trim opts.name) with
+  | None, None ->
+      Error (Error.make Error.Missing_target "name or id is required")
+  | Some id, None -> Ok (make repo graph (Some id) None)
+  | None, Some name when name <> "" -> Ok (make repo graph None (Some name))
+  | None, Some _ -> Error (Error.invalid_options "name must be non-empty")
+  | Some _, Some _ ->
+      Error (Error.invalid_options "only one of --id or --name is allowed")
+
+let build ?registry:_ config _globals parsed =
+  Error.bind (validate_parsed parsed) (fun () ->
+      Error.bind (repo_or_error config) (fun (repo, graph) ->
+          match parsed with
+          | Parsed_block opts -> build_block repo graph opts
+          | Parsed_page opts -> build_page repo graph opts
+          | Parsed_tag opts ->
+              build_named
+                (fun repo graph id name -> Remove_tag { repo; graph; id; name })
+                repo graph opts
+          | Parsed_property opts ->
+              build_named
+                (fun repo graph id name ->
+                  Remove_property { repo; graph; id; name })
+                repo graph opts))
+
+let kw value = Edn_util.keyword value
+let vector_vec values = Edn_util.vector_vec values
+
+let block_selector =
+  vector_vec (Vec.of_array [| kw "db/id"; kw "block/uuid"; kw "block/name" |])
+
+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 entity_selector =
+  vector_vec
+    (Vec.of_array
+       [|
+         kw "db/id";
+         kw "db/ident";
+         kw "block/uuid";
+         kw "block/name";
+         kw "block/title";
+         kw "logseq.property/type";
+         kw "logseq.property/public?";
+         kw "logseq.property/built-in?";
+         Edn_util.map_vec
+           (Vec.of_array
+              [|
+                ( kw "block/tags",
+                  vector_vec
+                    (Vec.of_array
+                       [|
+                         kw "db/id";
+                         kw "db/ident";
+                         kw "block/title";
+                         kw "block/name";
+                       |]) );
+              |]);
+       |])
+
+let result_value value =
+  Edn_util.map_vec (Vec.of_array [| (kw "result", value) |])
+
+let entity_result_value result id name =
+  Edn_util.map_vec
+    (Vec.of_array
+       [|
+         (kw "result", result);
+         (kw "id", Edn_util.int64 id);
+         (kw "name", Edn_util.string name);
+       |])
+
+let multi_block_result ~deleted_ids ~missing_ids ~result ~page_ids =
+  let fields =
+    Vec.of_array
+      [|
+        ( kw "deleted-ids",
+          Edn_util.vector_vec
+            (deleted_ids |> Vec.map (fun id -> Edn_util.int64 id)) );
+        ( kw "missing-ids",
+          Edn_util.vector_vec
+            (missing_ids |> Vec.map (fun id -> Edn_util.int64 id)) );
+        (kw "result", result);
+      |]
+  in
+  let fields =
+    if Vec.is_empty page_ids then fields
+    else
+      let ids = page_ids in
+      Vec.push_back fields
+        ( kw "page-ids",
+          Edn_util.vector_vec (ids |> Vec.map (fun id -> Edn_util.int64 id)) )
+  in
+  Edn_util.map_vec fields
+
+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 has_name value = Option.is_some (Edn_util.get_string value "block/name")
+let has_id value = Option.is_some (Edn_util.get_int64 value "db/id")
+
+let pull config repo selector lookup =
+  Transport.thread_api_pull config ~repo
+    ~selector:(Edn_util.expect_vector_t "remove pull selector" selector)
+    ~lookup
+
+let list_named_entities config repo method_ =
+  let options =
+    Edn_util.map_t_vec
+      (Vec.of_array
+         [|
+           (kw "include-built-in", Edn_util.bool true);
+           (kw "expand", Edn_util.bool true);
+         |])
+  in
+  match Edn_util.keyword_to_string method_ with
+  | "thread-api/cli-list-pages" ->
+      Transport.thread_api_cli_list_pages config ~repo ~options
+  | "thread-api/cli-list-tags" ->
+      Transport.thread_api_cli_list_tags config ~repo ~options
+  | "thread-api/cli-list-properties" ->
+      Transport.thread_api_cli_list_properties config ~repo ~options
+  | method_name -> invalid_arg ("unsupported list method: " ^ method_name)
+
+let list_pages config repo =
+  list_named_entities config repo
+    (Edn_util.keyword_t "thread-api/cli-list-pages")
+
+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 apply_delete_op config repo op =
+  let open Cli_effect in
+  bind (apply_outliner_ops config repo (Vec.singleton op)) (fun response ->
+      let result =
+        if Edn_util.is_null response then Edn_util.bool true
+        else
+          match Edn_util.get response "result" with
+          | Some result -> result
+          | None -> response
+      in
+      pure result)
+
+let delete_block_uuids config repo uuids =
+  let op =
+    Edn_util.vector_vec
+      (Vec.of_array
+         [|
+           kw "delete-blocks";
+           Edn_util.vector_vec
+             (Vec.of_array
+                [|
+                  Edn_util.vector_vec
+                    (uuids |> Vec.map (fun uuid -> Edn_util.uuid uuid));
+                  Edn_util.map_vec Vec.empty;
+                |]);
+         |])
+  in
+  apply_delete_op config repo op
+
+let delete_page_uuid config repo uuid =
+  let op =
+    Edn_util.vector_vec
+      (Vec.of_array
+         [|
+           kw "delete-page";
+           Edn_util.vector_vec
+             (Vec.of_array [| Edn_util.uuid uuid; Edn_util.map_vec Vec.empty |]);
+         |])
+  in
+  apply_delete_op config repo op
+
+let entities_of_value value =
+  match
+    (Edn_util.as_list value, Edn_util.as_vector value, Edn_util.as_map value)
+  with
+  | Some pages, _, _ | _, Some pages, _ -> pages
+  | _, _, Some _ -> Vec.singleton value
+  | _ -> Vec.empty
+
+let entity_name value =
+  match Edn_util.get_string value "block/title" with
+  | Some title -> Some title
+  | None -> (
+      match Edn_util.get_string value "block/name" with
+      | Some name -> Some name
+      | None -> (
+          match Edn_util.get_string value "title" with
+          | Some title -> Some title
+          | None -> Edn_util.get_string value "name"))
+
+let normalize_name name = String.lowercase_ascii (String.trim name)
+
+let name_matches target entity =
+  let target = normalize_name target in
+  let candidates =
+    Vec.of_array
+      [|
+        entity_name entity;
+        Edn_util.get_string entity "block/name";
+        Edn_util.get_string entity "block/title";
+        Edn_util.get_string entity "name";
+        Edn_util.get_string entity "title";
+      |]
+  in
+  Vec.exists
+    (function
+      | Some candidate -> String.equal target (normalize_name candidate)
+      | None -> false)
+    candidates
+
+let candidate_of_entity entity =
+  match id_of_entity entity with
+  | Some id -> Some { Error.id = Some id; name = entity_name entity }
+  | None -> None
+
+let plural_label = function "property" -> "properties" | label -> label ^ "s"
+
+let ambiguous_error code label name matches =
+  Error.make
+    ~candidates:(Vec.filter_map candidate_of_entity matches)
+    code
+    ("multiple " ^ plural_label label ^ " match name: " ^ name
+   ^ "; rerun with --id")
+
+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 property_entity value =
+  Option.is_some (Edn_util.get value "logseq.property/type")
+
+let validate_tag_target entity =
+  if not (has_id entity) then
+    Error (Error.make Error.Tag_not_found "tag not found")
+  else if not (tag_entity entity) then
+    Error (Error.make Error.Invalid_tag_target "target is not a tag")
+  else if Edn_util.get_bool entity "logseq.property/built-in?" = Some true then
+    Error (Error.make Error.Tag_built_in "built-in tag cannot be removed")
+  else if Edn_util.get_bool entity "logseq.property/public?" = Some false then
+    Error (Error.make Error.Tag_hidden "hidden tag cannot be removed")
+  else
+    match uuid_of_entity entity with
+    | Some _ -> Ok entity
+    | None -> Error (Error.make Error.Tag_not_found "tag uuid not found")
+
+let validate_property_target entity =
+  if not (has_id entity) then
+    Error (Error.make Error.Property_not_found "property not found")
+  else if not (property_entity entity) then
+    Error (Error.make Error.Invalid_property_target "target is not a property")
+  else if Edn_util.get_bool entity "logseq.property/built-in?" = Some true then
+    Error
+      (Error.make Error.Property_built_in "built-in property cannot be removed")
+  else if Edn_util.get_bool entity "logseq.property/public?" = Some false then
+    Error (Error.make Error.Property_hidden "hidden property cannot be removed")
+  else
+    match uuid_of_entity entity with
+    | Some _ -> Ok entity
+    | None ->
+        Error (Error.make Error.Property_not_found "property uuid not found")
+
+let target_name label action_name entity =
+  match action_name with
+  | Some name -> name
+  | None -> ( match entity_name entity with Some name -> name | None -> label)
+
+let delete_resolved_block mode invoke_config repo entity =
+  let open Cli_effect in
+  if not (has_id entity) then
+    pure
+      (Cli_result.error ~command:Command_id.Remove_block mode
+         (Error.make Error.Block_not_found "block not found"))
+  else if has_name entity then
+    pure
+      (Cli_result.error ~command:Command_id.Remove_block mode
+         (Error.make Error.Invalid_target
+            "target is not a block, use 'remove page' instead"))
+  else
+    match uuid_of_entity entity with
+    | None ->
+        pure
+          (Cli_result.error ~command:Command_id.Remove_block mode
+             (Error.make Error.Block_not_found "block uuid not found"))
+    | Some uuid ->
+        bind
+          (delete_block_uuids invoke_config repo (Vec.singleton uuid))
+          (fun result ->
+            pure
+              (Cli_result.ok ~command:Command_id.Remove_block mode
+                 (Raw (result_value result))))
+
+let execute_remove_block_id mode invoke_config repo id =
+  let open Cli_effect in
+  bind
+    (pull invoke_config repo block_selector (Edn_util.int64 id))
+    (delete_resolved_block mode invoke_config repo)
+
+let execute_remove_block_uuid mode invoke_config repo uuid =
+  let open Cli_effect in
+  let lookup =
+    vector_vec (Vec.of_array [| kw "block/uuid"; Edn_util.uuid uuid |])
+  in
+  bind (pull invoke_config repo block_selector lookup) (fun entity ->
+      if has_id entity then delete_resolved_block mode invoke_config repo entity
+      else
+        let string_lookup =
+          vector_vec (Vec.of_array [| kw "block/uuid"; Edn_util.string uuid |])
+        in
+        bind
+          (pull invoke_config repo block_selector string_lookup)
+          (delete_resolved_block mode invoke_config repo))
+
+let execute_remove_block_ids mode invoke_config repo ids =
+  let open Cli_effect in
+  let entity_effects =
+    map_s
+      (fun id -> pull invoke_config repo block_selector (Edn_util.int64 id))
+      ids
+  in
+  bind entity_effects (fun entities ->
+      let id_entities = Vec.combine ids entities in
+      let deleted_ids =
+        id_entities
+        |> Vec.filter_map (fun (id, entity) ->
+            if has_id entity && not (has_name entity) then Some id else None)
+      in
+      let deleted_uuids =
+        id_entities
+        |> Vec.filter_map (fun (_, entity) ->
+            if has_id entity && not (has_name entity) then uuid_of_entity entity
+            else None)
+      in
+      let missing_ids =
+        id_entities
+        |> Vec.filter_map (fun (id, entity) ->
+            if has_id entity then None else Some id)
+      in
+      let page_ids =
+        id_entities
+        |> Vec.filter_map (fun (id, entity) ->
+            if has_id entity && has_name entity then Some id else None)
+      in
+      if Vec.is_empty deleted_ids && not (Vec.is_empty page_ids) then
+        pure
+          (Cli_result.error ~command:Command_id.Remove_block mode
+             (Error.make Error.Invalid_target
+                "target is not a block, use 'remove page' instead"))
+      else
+        let delete_effect =
+          if Vec.is_empty deleted_uuids then pure Edn_util.nil
+          else delete_block_uuids invoke_config repo deleted_uuids
+        in
+        bind delete_effect (fun result ->
+            pure
+              (Cli_result.ok ~command:Command_id.Remove_block mode
+                 (Raw
+                    (multi_block_result ~deleted_ids ~missing_ids ~result
+                       ~page_ids)))))
+
+let execute_remove_page_id mode invoke_config repo id =
+  let open Cli_effect in
+  bind
+    (pull invoke_config repo page_selector (Edn_util.int64 id))
+    (fun entity ->
+      if not (has_id entity) then
+        pure
+          (Cli_result.error ~command:Command_id.Remove_page mode
+             (Error.make Error.Page_not_found "page not found"))
+      else
+        match uuid_of_entity entity with
+        | None ->
+            pure
+              (Cli_result.error ~command:Command_id.Remove_page mode
+                 (Error.make Error.Page_not_found "page not found"))
+        | Some uuid ->
+            bind (delete_page_uuid invoke_config repo uuid) (fun result ->
+                pure
+                  (Cli_result.ok ~command:Command_id.Remove_page mode
+                     (Raw (result_value result)))))
+
+let execute_remove_page_name mode invoke_config repo name =
+  let open Cli_effect in
+  bind (list_pages invoke_config repo) (fun pages_value ->
+      let matches =
+        pages_value |> entities_of_value |> Vec.filter (name_matches name)
+      in
+      if Vec.is_empty matches then
+        pure
+          (Cli_result.error ~command:Command_id.Remove_page mode
+             (Error.make Error.Page_not_found "page not found"))
+      else if Vec.length matches > 1 then
+        pure
+          (Cli_result.error ~command:Command_id.Remove_page mode
+             (ambiguous_error Error.Ambiguous_page_name "page" name matches))
+      else
+        let page = Vec.nth matches 0 in
+        match uuid_of_entity page with
+        | None ->
+            pure
+              (Cli_result.error ~command:Command_id.Remove_page mode
+                 (Error.make Error.Page_not_found "page not found"))
+        | Some uuid ->
+            bind (delete_page_uuid invoke_config repo uuid) (fun result ->
+                pure
+                  (Cli_result.ok ~command:Command_id.Remove_page mode
+                     (Raw (result_value result)))))
+
+let execute_remove_entity mode invoke_config repo ~command ~list_method
+    ~not_found_code ~ambiguous_code ~label ~validate ~id ~name =
+  let open Cli_effect in
+  let delete entity resolved_name =
+    match validate entity with
+    | Error err -> pure (Cli_result.error ~command mode err)
+    | Ok entity -> (
+        match (id_of_entity entity, uuid_of_entity entity) with
+        | Some id, Some uuid ->
+            bind (delete_page_uuid invoke_config repo uuid) (fun result ->
+                pure
+                  (Cli_result.ok ~command mode
+                     (Raw
+                        (entity_result_value result id
+                           (target_name label resolved_name entity)))))
+        | _ ->
+            pure
+              (Cli_result.error ~command mode
+                 (Error.make not_found_code (label ^ " not found"))))
+  in
+  match (id, name) with
+  | Some id, _ ->
+      bind
+        (pull invoke_config repo entity_selector (Edn_util.int64 id))
+        (fun entity -> delete entity None)
+  | None, Some name ->
+      bind (list_named_entities invoke_config repo list_method)
+        (fun items_value ->
+          let matches =
+            items_value |> entities_of_value |> Vec.filter (name_matches name)
+          in
+          if Vec.is_empty matches then
+            pure
+              (Cli_result.error ~command mode
+                 (Error.make not_found_code (label ^ " not found")))
+          else if Vec.length matches > 1 then
+            pure
+              (Cli_result.error ~command mode
+                 (ambiguous_error ambiguous_code label name matches))
+          else
+            let item = Vec.nth matches 0 in
+            let lookup_name =
+              Option.value
+                (Option.map normalize_name (entity_name item))
+                ~default:(normalize_name name)
+            in
+            let lookup =
+              vector_vec
+                (Vec.of_array
+                   [| kw "block/name"; Edn_util.string lookup_name |])
+            in
+            let resolved_name = entity_name item in
+            bind (pull invoke_config repo entity_selector lookup) (fun entity ->
+                delete entity resolved_name))
+  | None, None ->
+      pure
+        (Cli_result.error ~command mode
+           (Error.make Error.Missing_target (label ^ " name or id is required")))
+
+let execute_with_mode action config mode =
+  let open Cli_effect in
+  match action with
+  | Remove_block { repo; id = Some id; _ } ->
+      bind (Server_runtime.ensure_server config repo ~create_empty_db:false)
+        (function
+        | Error err ->
+            pure (Cli_result.error ~command:Command_id.Remove_block mode err)
+        | Ok invoke_config -> execute_remove_block_id mode invoke_config repo id)
+  | Remove_block { repo; ids; multi_id = true; _ } when not (Vec.is_empty ids)
+    ->
+      bind (Server_runtime.ensure_server config repo ~create_empty_db:false)
+        (function
+        | Error err ->
+            pure (Cli_result.error ~command:Command_id.Remove_block mode err)
+        | Ok invoke_config ->
+            execute_remove_block_ids mode invoke_config repo ids)
+  | Remove_block { repo; uuid = Some uuid; _ } ->
+      bind (Server_runtime.ensure_server config repo ~create_empty_db:false)
+        (function
+        | Error err ->
+            pure (Cli_result.error ~command:Command_id.Remove_block mode err)
+        | Ok invoke_config ->
+            execute_remove_block_uuid mode invoke_config repo uuid)
+  | Remove_block _ ->
+      pure
+        (Cli_result.error ~command:Command_id.Remove_block mode
+           (Error.make Error.Missing_target "block is required"))
+  | Remove_page { repo; id = Some id; _ } ->
+      bind (Server_runtime.ensure_server config repo ~create_empty_db:false)
+        (function
+        | Error err ->
+            pure (Cli_result.error ~command:Command_id.Remove_page mode err)
+        | Ok invoke_config -> execute_remove_page_id mode invoke_config repo id)
+  | Remove_page { repo; page = Some page; _ } ->
+      bind (Server_runtime.ensure_server config repo ~create_empty_db:false)
+        (function
+        | Error err ->
+            pure (Cli_result.error ~command:Command_id.Remove_page mode err)
+        | Ok invoke_config ->
+            execute_remove_page_name mode invoke_config repo page)
+  | Remove_page _ ->
+      pure
+        (Cli_result.error ~command:Command_id.Remove_page mode
+           (Error.make Error.Missing_page_name "page name or id is required"))
+  | Remove_tag { repo; id; name; _ } ->
+      bind (Server_runtime.ensure_server config repo ~create_empty_db:false)
+        (function
+        | Error err ->
+            pure (Cli_result.error ~command:Command_id.Remove_tag mode err)
+        | Ok invoke_config ->
+            execute_remove_entity mode invoke_config repo
+              ~command:Command_id.Remove_tag
+              ~list_method:(Edn_util.keyword_t "thread-api/cli-list-tags")
+              ~not_found_code:Error.Tag_not_found
+              ~ambiguous_code:Error.Ambiguous_tag_name ~label:"tag"
+              ~validate:validate_tag_target ~id ~name)
+  | Remove_property { repo; id; name; _ } ->
+      bind (Server_runtime.ensure_server config repo ~create_empty_db:false)
+        (function
+        | Error err ->
+            pure (Cli_result.error ~command:Command_id.Remove_property mode err)
+        | Ok invoke_config ->
+            execute_remove_entity mode invoke_config repo
+              ~command:Command_id.Remove_property
+              ~list_method:(Edn_util.keyword_t "thread-api/cli-list-properties")
+              ~not_found_code:Error.Property_not_found
+              ~ambiguous_code:Error.Ambiguous_property_name ~label:"property"
+              ~validate:validate_property_target ~id ~name)
+
+let meta ?(examples = Vec.empty) id doc =
+  {
+    Command_registry.id;
+    path = Command_id.to_path id;
+    doc;
+    long_doc = None;
+    examples;
+    options = Vec.empty;
+    category = Command_registry.Graph_inspect_and_edit;
+    requires_graph = Command_id.requires_graph id;
+    requires_auth = Command_id.requires_auth id;
+    write_command = Command_id.is_write id;
+    human_table_headers_order = Vec.empty;
+  }
+
+let metadata () =
+  Vec.of_array
+    [|
+      meta
+        ~examples:
+          (Vec.of_array
+             [|
+               "logseq remove block --graph my-graph --id 123";
+               "logseq remove block --graph my-graph --id '[123,456]'";
+               "logseq remove block --graph my-graph --uuid \
+                7f0f4bb3-2e48-4b46-ae0f-18f52ef0f8be";
+             |])
+        Command_id.Remove_block "Remove blocks";
+      meta
+        ~examples:
+          (Vec.of_array
+             [|
+               "logseq remove page --graph my-graph --page Home";
+               "logseq remove page --graph my-graph --id 123";
+             |])
+        Remove_page "Remove page";
+      meta
+        ~examples:
+          (Vec.singleton "logseq remove tag --graph my-graph --name project")
+        Remove_tag "Remove tag";
+      meta
+        ~examples:
+          (Vec.of_array
+             [|
+               "logseq remove property --graph my-graph --name owner";
+               "logseq remove property --graph my-graph --id 321";
+             |])
+        Remove_property "Remove property";
+    |]
+
+let execute action config =
+  let (Output.Mode.Packed mode) = Output_mode.for_config config in
+  execute_with_mode action config mode

cli/lib/root_dir_types.ml

@@ -0,0 +1,48 @@
+let default_root_dir () = Cli_config.default_root_dir ()
+
+let starts_with ~prefix value =
+  let prefix_len = String.length prefix in
+  String.length value >= prefix_len && String.sub value 0 prefix_len = prefix
+
+let expand_home path =
+  match Sys.getenv_opt "HOME" with
+  | Some home when path = "~" -> home
+  | Some home when starts_with ~prefix:"~/" path ->
+      Filename.concat home (String.sub path 2 (String.length path - 2))
+  | _ -> path
+
+let normalize_root_dir root =
+  let path =
+    root |> Option.value ~default:(default_root_dir ()) |> expand_home
+  in
+  if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path
+  else path
+
+let rec mkdir_p path =
+  if path = "" || path = Filename.dirname path || Cli_unix.file_exists path then
+    ()
+  else (
+    mkdir_p (Filename.dirname path);
+    Cli_unix.mkdir path 0o755)
+
+let root_dir_error path message =
+  Error.make
+    ~context:
+      (Edn_util.map_vec
+         (Vec.of_array [| (Edn_util.keyword "path", Edn_util.string path) |]))
+    Error.Root_dir_permission message
+
+let ensure_root_dir root =
+  let path = normalize_root_dir root in
+  try
+    mkdir_p path;
+    if not (Cli_unix.is_directory path) then
+      Error (root_dir_error path ("root-dir is not a directory: " ^ path))
+    else (
+      Cli_unix.access path (Vec.of_array [| Cli_unix.R_OK; Cli_unix.W_OK |]);
+      Ok path)
+  with exn ->
+    Error
+      (root_dir_error path
+         ("root-dir is not readable/writable: " ^ path ^ " ("
+        ^ Printexc.to_string exn ^ ")"))

cli/lib/search.ml

@@ -0,0 +1,294 @@
+type scope = Block | Page | Property | Tag
+type opts = { content : string }
+
+type parsed =
+  | Parsed_block of opts
+  | Parsed_page of opts
+  | Parsed_property of opts
+  | Parsed_tag of opts
+
+type action = {
+  scope : scope;
+  command : Command_id.t;
+  repo : Cli_primitive.repo;
+  graph : Cli_primitive.graph;
+  query : string;
+}
+
+let scope_of_parsed = function
+  | Parsed_block _ -> Block
+  | Parsed_page _ -> Page
+  | Parsed_property _ -> Property
+  | Parsed_tag _ -> Tag
+
+let command_id = function
+  | Parsed_block _ -> Command_id.Search_block
+  | Parsed_page _ -> Search_page
+  | Parsed_property _ -> Search_property
+  | Parsed_tag _ -> Search_tag
+
+let validate_parsed _ = Ok ()
+
+let opts_of_parsed = function
+  | Parsed_block opts
+  | Parsed_page opts
+  | Parsed_property opts
+  | Parsed_tag opts ->
+      opts
+
+let trim_query parsed = (opts_of_parsed parsed).content |> String.trim
+
+let build ?registry:_ config _globals parsed =
+  match config.Cli_config.repo with
+  | None -> Error (Error.missing_repo "repo is required for search")
+  | Some repo ->
+      let query = trim_query parsed in
+      if query = "" then
+        Error
+          (Error.make
+             ~hint:
+               "Use: logseq search <block|page|property|tag> --content <query>"
+             Error.Missing_query_text "query text is required")
+      else
+        Ok
+          {
+            scope = scope_of_parsed parsed;
+            command = command_id parsed;
+            repo;
+            graph = Cli_config.repo_to_graph repo;
+            query;
+          }
+
+let items_value items =
+  Edn_util.map_vec
+    (Vec.of_array [| (Edn_util.keyword "items", Edn_util.vector_vec items) |])
+
+let sym name = Edn_util.symbol name
+let kw name = Edn_util.keyword name
+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 variable name = sym ("?" ^ name)
+let call name args = Edn_util.list_vec (Vec.push_front args (sym name))
+let where_v values = Cli_primitive.V (Edn_util.vector_t_vec values)
+
+let query_value query =
+  Edn_util.any (Cli_primitive.datascript_query_to_edn query)
+
+let pull_attrs = function
+  | Block ->
+      Vec.of_array
+        [|
+          kw "db/id";
+          kw "db/ident";
+          kw "block/title";
+          kw "logseq.property/deleted-at";
+          Edn_util.map_vec (Vec.of_array [| (kw "block/parent", sym "...") |]);
+        |]
+  | Page ->
+      Vec.of_array
+        [|
+          kw "db/id";
+          kw "db/ident";
+          kw "block/title";
+          kw "logseq.property/deleted-at";
+        |]
+  | Property | Tag ->
+      Vec.of_array [| kw "db/id"; kw "db/ident"; kw "block/title" |]
+
+let text_attr = function
+  | Block -> kw "block/title"
+  | Page -> kw "block/name"
+  | Property | Tag -> kw "block/title"
+
+let class_filter = function
+  | Property -> Some (kw "logseq.class/Property")
+  | Tag -> Some (kw "logseq.class/Tag")
+  | Block | Page -> None
+
+let query_of_scope scope =
+  let entity = variable "e" in
+  let query = variable "query" in
+  let title = variable "title" in
+  let title_lower = variable "title-lower" in
+  let query_lower = variable "query-lower" in
+  let where =
+    Vec.of_array
+      [|
+        where_v (Vec.of_array [| entity; text_attr scope; title |]);
+        where_v
+          (Vec.of_array
+             [|
+               call "clojure.string/lower-case" (Vec.singleton title);
+               title_lower;
+             |]);
+        where_v
+          (Vec.of_array
+             [|
+               call "clojure.string/lower-case" (Vec.singleton query);
+               query_lower;
+             |]);
+        where_v
+          (Vec.of_array
+             [|
+               call "clojure.string/includes?"
+                 (Vec.of_array [| title_lower; query_lower |]);
+             |]);
+      |]
+    |> fun clauses ->
+    match class_filter scope with
+    | Some class_ ->
+        Vec.push_front clauses
+          (where_v (Vec.of_array [| entity; kw "block/tags"; class_ |]))
+    | None -> clauses
+  in
+  Cli_primitive.make_datascript_query
+    ~find:
+      (Vec.of_array
+         [|
+           vector_vec
+             (Vec.of_array
+                [|
+                  list_vec
+                    (Vec.of_array
+                       [| sym "pull"; entity; vector (pull_attrs scope) |]);
+                  sym "...";
+                |]);
+         |])
+    ~in_:
+      (Vec.of_array
+         [|
+           Melange_edn_melange.symbol "$"; Melange_edn_melange.symbol "?query";
+         |])
+    ~where ()
+
+let search_result_keys = Vec.of_array [| "db/id"; "db/ident"; "block/title" |]
+
+let select_search_item item =
+  Edn_util.map_vec
+    (Vec.filter_map
+       (fun key ->
+         Option.map
+           (fun value -> (Edn_util.keyword key, value))
+           (Edn_util.get item key))
+       search_result_keys)
+
+let rec recycled item =
+  match Edn_util.as_map item with
+  | Some _ -> (
+      Option.is_some (Edn_util.get item "logseq.property/deleted-at")
+      ||
+      match Edn_util.get item "block/parent" with
+      | Some parent -> recycled parent
+      | None -> false)
+  | None -> false
+
+let compare_search_item a b =
+  let title item =
+    Edn_util.get_string item "block/title"
+    |> Option.value ~default:"" |> String.lowercase_ascii
+  in
+  let id item =
+    Edn_util.get_int64 item "db/id" |> Option.value ~default:Int64.max_int
+  in
+  let title_cmp = String.compare (title a) (title b) in
+  if title_cmp <> 0 then title_cmp else Int64.compare (id a) (id b)
+
+let normalize_items scope items =
+  let items =
+    match scope with
+    | Block | Page -> Vec.filter (fun item -> not (recycled item)) items
+    | Property | Tag -> items
+  in
+  items
+  |> Vec.filter (fun value -> Option.is_some (Edn_util.as_map value))
+  |> Vec.map select_search_item
+  |> Vec.sort compare_search_item
+
+let normalize_uuid_refs config repo items =
+  let entities = Vec.map Entity.of_value items in
+  let uuids =
+    Uuid_refs_types.collect_uuid_refs_from_items entities
+      (Vec.singleton (Edn_util.keyword_t "block/title"))
+  in
+  if Vec.is_empty uuids then Cli_effect.pure items
+  else
+    Cli_effect.map
+      (fun labels ->
+        Uuid_refs_types.normalize_item_string_fields entities
+          (Vec.singleton (Edn_util.keyword_t "block/title"))
+          labels
+        |> Vec.map (fun item -> item.Entity.raw))
+      (Uuid_refs_types.fetch_uuid_labels config repo uuids)
+
+let execute_with_mode action config mode =
+  let open Cli_effect in
+  bind (Server_runtime.ensure_server config action.repo ~create_empty_db:false)
+    (function
+    | Error err -> pure (Output_mode.error ~command:action.command mode err)
+    | Ok invoke_config ->
+        bind
+          (Transport.thread_api_q invoke_config ~repo:action.repo
+             ~query:
+               (Edn_util.vector_t_vec
+                  (Vec.of_array
+                     [|
+                       query_value (query_of_scope action.scope);
+                       Edn_util.string action.query;
+                     |])))
+          (fun value ->
+            let items =
+              match (Edn_util.as_vector value, Edn_util.as_list value) with
+              | Some xs, _ | _, Some xs -> xs
+              | _ when Edn_util.is_null value -> Vec.empty
+              | _ -> Vec.singleton value
+            in
+            let items = normalize_items action.scope items in
+            bind (normalize_uuid_refs config action.repo items) (fun items ->
+                pure
+                  (Cli_result.ok ~command:action.command mode
+                     (Raw (items_value items))))))
+
+let meta ?(examples = Vec.empty) id doc =
+  {
+    Command_registry.id;
+    path = Command_id.to_path id;
+    doc;
+    long_doc = None;
+    examples;
+    options = Vec.empty;
+    category = Command_registry.Graph_inspect_and_edit;
+    requires_graph = Command_id.requires_graph id;
+    requires_auth = Command_id.requires_auth id;
+    write_command = Command_id.is_write id;
+    human_table_headers_order = Vec.empty;
+  }
+
+let metadata () =
+  Vec.of_array
+    [|
+      meta
+        ~examples:
+          (Vec.singleton
+             "logseq search block --content \"task\" --graph my-graph")
+        Command_id.Search_block "Search blocks by title";
+      meta
+        ~examples:
+          (Vec.singleton
+             "logseq search page --content \"home\" --graph my-graph")
+        Search_page "Search pages by name";
+      meta
+        ~examples:
+          (Vec.singleton
+             "logseq search property --content \"owner\" --graph my-graph")
+        Search_property "Search properties by title";
+      meta
+        ~examples:
+          (Vec.singleton
+             "logseq search tag --content \"quote\" --graph my-graph")
+        Search_tag "Search tags by title";
+    |]
+
+let execute action config =
+  let (Output.Mode.Packed mode) = Output_mode.for_config config in
+  execute_with_mode action config mode

cli/lib/selector.ml

@@ -0,0 +1,26 @@
+type block =
+  | Block_id of Cli_primitive.db_id
+  | Block_uuid of Cli_primitive.uuid
+
+type page =
+  | Page_id of Cli_primitive.db_id
+  | Page_name of string
+  | Page_uuid of Cli_primitive.uuid
+
+type property =
+  | Property_id of Cli_primitive.db_id
+  | Property_ident of Cli_primitive.keyword
+  | Property_name of string
+  | Property_uuid of Cli_primitive.uuid
+
+type tag =
+  | Tag_id of Cli_primitive.db_id
+  | Tag_name of string
+  | Tag_ident of Cli_primitive.keyword
+  | Tag_uuid of Cli_primitive.uuid
+
+type entity =
+  | Entity_id of Cli_primitive.db_id
+  | Entity_uuid of Cli_primitive.uuid
+  | Entity_ident of Cli_primitive.keyword
+  | Entity_name of string

cli/lib/server_command.ml

@@ -0,0 +1,234 @@
+type parsed =
+  | Parsed_list
+  | Parsed_cleanup
+  | Parsed_start
+  | Parsed_stop
+  | Parsed_restart
+
+type action =
+  | Server_list
+  | Server_cleanup
+  | Server_start of { repo : Cli_primitive.repo; graph : Cli_primitive.graph }
+  | Server_stop of { repo : Cli_primitive.repo; graph : Cli_primitive.graph }
+  | Server_restart of { repo : Cli_primitive.repo; graph : Cli_primitive.graph }
+
+let command_id = function
+  | Parsed_list -> Command_id.Server_list
+  | Parsed_cleanup -> Server_cleanup
+  | Parsed_start -> Server_start
+  | Parsed_stop -> Server_stop
+  | Parsed_restart -> Server_restart
+
+let validate_parsed _ = Ok ()
+
+let action_with_repo config make message =
+  match config.Cli_config.repo with
+  | Some repo -> Ok (make repo (Cli_config.repo_to_graph repo))
+  | None -> Error (Error.missing_repo message)
+
+let build ?registry:_ config _globals = function
+  | Parsed_list -> Ok Server_list
+  | Parsed_cleanup -> Ok Server_cleanup
+  | Parsed_start ->
+      action_with_repo config
+        (fun repo graph -> Server_start { repo; graph })
+        "repo is required for server start"
+  | Parsed_stop ->
+      action_with_repo config
+        (fun repo graph -> Server_stop { repo; graph })
+        "repo is required for server stop"
+  | Parsed_restart ->
+      action_with_repo config
+        (fun repo graph -> Server_restart { repo; graph })
+        "repo is required for server restart"
+
+let status_value = function
+  | Server_runtime.Starting -> Edn_util.string "starting"
+  | Ready -> Edn_util.string "ready"
+  | Error -> Edn_util.string "error"
+  | Unknown -> Edn_util.string "unknown"
+
+let owner_source_value source =
+  Edn_util.string (Cli_primitive.string_of_owner_source source)
+
+let optional_string key = function
+  | Some value -> Vec.singleton (Edn_util.keyword key, Edn_util.string value)
+  | None -> Vec.empty
+
+let server_value (server : Server_runtime.server) =
+  Edn_util.map_vec
+    ( Vec.of_array
+        [|
+          ( Edn_util.keyword "repo",
+            Edn_util.string (Cli_primitive.string_of_repo server.repo) );
+          ( Edn_util.keyword "graph",
+            match server.graph with
+            | Some graph ->
+                Edn_util.string (Cli_primitive.string_of_graph graph)
+            | None -> Edn_util.nil );
+          (Edn_util.keyword "pid", Edn_util.int server.pid);
+          (Edn_util.keyword "host", Edn_util.string server.host);
+          (Edn_util.keyword "port", Edn_util.int server.port);
+          (Edn_util.keyword "base-url", Edn_util.string server.base_url);
+          (Edn_util.keyword "status", status_value server.status);
+          ( Edn_util.keyword "owner-source",
+            owner_source_value server.owner_source );
+          (Edn_util.keyword "owned", Edn_util.bool server.owned);
+        |]
+    |> fun fields ->
+      Vec.append fields (optional_string "revision" server.revision)
+      |> fun fields ->
+      Vec.append fields (optional_string "root-dir" server.root_dir) )
+
+let start_result_value (result : Server_runtime.start_result) =
+  Edn_util.map_vec
+    (Vec.of_array
+       [|
+         ( Edn_util.keyword "repo",
+           Edn_util.string (Cli_primitive.string_of_repo result.repo) );
+         ( Edn_util.keyword "owner-source",
+           owner_source_value result.owner_source );
+         (Edn_util.keyword "owned", Edn_util.bool result.owned);
+       |])
+
+let stop_result_value (result : Server_runtime.stop_result) =
+  Edn_util.map_vec
+    (Vec.of_array
+       [|
+         ( Edn_util.keyword "repo",
+           Edn_util.string (Cli_primitive.string_of_repo result.repo) );
+       |])
+
+let error_value (err : Error.t) =
+  Edn_util.map_vec
+    (Vec.of_array
+       [|
+         ( Edn_util.keyword "code",
+           Edn_util.string (Error.code_to_string err.code) );
+         (Edn_util.keyword "message", Edn_util.string err.message);
+       |])
+
+let failed_cleanup_value (server, err) =
+  match Edn_util.as_map (server_value server) with
+  | Some fields ->
+      Edn_util.map_vec
+        (Vec.push_back fields (Edn_util.keyword "error", error_value err))
+  | None ->
+      Edn_util.map_vec
+        (Vec.of_array
+           [|
+             (Edn_util.keyword "server", server_value server);
+             (Edn_util.keyword "error", error_value err);
+           |])
+
+let execute_with_mode action config mode =
+  let open Cli_effect in
+  match action with
+  | Server_list ->
+      bind (Server_runtime.list_servers config) (fun servers ->
+          pure
+            (Cli_result.ok ~command:Command_id.Server_list mode
+               (Raw
+                  (Edn_util.map_vec
+                     (Vec.of_array
+                        [|
+                          ( Edn_util.keyword "servers",
+                            Edn_util.vector_vec (servers |> Vec.map server_value)
+                          );
+                        |])))))
+  | Server_cleanup ->
+      bind
+        (Server_runtime.cleanup_revision_mismatched_servers config
+           ~cli_revision:"unknown") (function
+        | Ok result ->
+            pure
+              (Cli_result.ok ~command:Command_id.Server_cleanup mode
+                 (Raw
+                    (Edn_util.map_vec
+                       (Vec.of_array
+                          [|
+                            ( Edn_util.keyword "cli-revision",
+                              Edn_util.string result.cli_revision );
+                            ( Edn_util.keyword "checked",
+                              Edn_util.int result.checked );
+                            ( Edn_util.keyword "mismatched",
+                              Edn_util.int result.mismatched );
+                            ( Edn_util.keyword "eligible",
+                              Edn_util.int result.eligible );
+                            ( Edn_util.keyword "skipped-owner",
+                              Edn_util.int result.skipped_owner );
+                            ( Edn_util.keyword "killed",
+                              Edn_util.vector_vec
+                                (result.killed |> Vec.map server_value) );
+                            ( Edn_util.keyword "failed",
+                              Edn_util.vector_vec
+                                (result.failed |> Vec.map failed_cleanup_value)
+                            );
+                          |]))))
+        | Error err ->
+            pure (Output_mode.error ~command:Command_id.Server_cleanup mode err))
+  | Server_start { repo; _ } ->
+      bind (Server_runtime.start_server config repo ~create_empty_db:false)
+        (function
+        | Ok result ->
+            pure
+              (Cli_result.ok ~command:Command_id.Server_start mode
+                 (Raw (start_result_value result)))
+        | Error err ->
+            pure (Output_mode.error ~command:Command_id.Server_start mode err))
+  | Server_stop { repo; _ } ->
+      bind (Server_runtime.stop_server config repo) (function
+        | Ok result ->
+            pure
+              (Cli_result.ok ~command:Command_id.Server_stop mode
+                 (Raw (stop_result_value result)))
+        | Error err ->
+            pure (Output_mode.error ~command:Command_id.Server_stop mode err))
+  | Server_restart { repo; _ } ->
+      bind (Server_runtime.restart_server config repo) (function
+        | Ok result ->
+            pure
+              (Cli_result.ok ~command:Command_id.Server_restart mode
+                 (Raw (start_result_value result)))
+        | Error err ->
+            pure (Output_mode.error ~command:Command_id.Server_restart mode err))
+
+let meta ?(examples = Vec.empty) id doc =
+  {
+    Command_registry.id;
+    path = Command_id.to_path id;
+    doc;
+    long_doc = None;
+    examples;
+    options = Vec.empty;
+    category = Command_registry.Graph_management;
+    requires_graph = Command_id.requires_graph id;
+    requires_auth = Command_id.requires_auth id;
+    write_command = Command_id.is_write id;
+    human_table_headers_order = Vec.empty;
+  }
+
+let metadata () =
+  Vec.of_array
+    [|
+      meta
+        ~examples:(Vec.singleton "logseq server list")
+        Command_id.Server_list "List db-worker-node servers";
+      meta
+        ~examples:(Vec.singleton "logseq server cleanup")
+        Server_cleanup
+        "Clean up revision-mismatched CLI-owned db-worker-node servers";
+      meta
+        ~examples:(Vec.singleton "logseq server start --graph my-graph")
+        Server_start "Start db-worker-node for a graph";
+      meta
+        ~examples:(Vec.singleton "logseq server stop --graph my-graph")
+        Server_stop "Stop db-worker-node for a graph";
+      meta
+        ~examples:(Vec.singleton "logseq server restart --graph my-graph")
+        Server_restart "Restart db-worker-node for a graph";
+    |]
+
+let execute action config =
+  let (Output.Mode.Packed mode) = Output_mode.for_config config in
+  execute_with_mode action config mode

cli/lib/server_runtime.ml

@@ -0,0 +1,714 @@
+open Cli_effect.Infix
+
+type server_status = Starting | Ready | Error | Unknown
+
+type server = {
+  repo : Cli_primitive.repo;
+  graph : Cli_primitive.graph option;
+  pid : Cli_primitive.pid;
+  host : string;
+  port : Cli_primitive.port;
+  base_url : Cli_primitive.url;
+  status : server_status;
+  revision : string option;
+  root_dir : Cli_primitive.path option;
+  owner_source : Cli_primitive.owner_source;
+  owned : bool;
+  raw : Melange_edn_melange.any option;
+}
+
+type start_result = {
+  repo : Cli_primitive.repo;
+  owner_source : Cli_primitive.owner_source;
+  owned : bool;
+}
+
+type stop_result = { repo : Cli_primitive.repo }
+type revision_mismatch = { cli_revision : string; servers : server Rrbvec.t }
+
+type cleanup_result = {
+  cli_revision : string;
+  checked : int;
+  mismatched : int;
+  eligible : int;
+  skipped_owner : int;
+  killed : server Rrbvec.t;
+  failed : (server * Error.t) Rrbvec.t;
+}
+
+let resolve_root_dir config = config.Cli_config.root_dir
+let graphs_dir config = Filename.concat (resolve_root_dir config) "graphs"
+
+let lock_path ~root_dir repo =
+  Filename.concat
+    (Filename.concat
+       (Filename.concat root_dir "graphs")
+       (Graph_dir.graph_dir_name_of_repo repo))
+    "db-worker.lock"
+
+let env_db_worker_script_path () =
+  match Sys.getenv_opt "LOGSEQ_DB_WORKER_NODE_SCRIPT" with
+  | Some path when String.trim path <> "" -> Some path
+  | _ -> None
+
+let cli_entrypoint_path () =
+  let argv = Cli_platform.argv () in
+  if Array.length argv > 1 then Some argv.(1) else None
+
+let parent_executable_path () =
+  let argv = Cli_platform.argv () in
+  if Array.length argv > 0 then argv.(0) else "node"
+
+let cli_dir_db_worker_script_paths () =
+  match cli_entrypoint_path () with
+  | Some entrypoint ->
+      let dir = Filename.dirname entrypoint in
+      Vec.of_array
+        [|
+          Filename.concat dir "db-worker-node.js";
+          Filename.concat (Filename.concat dir "js") "db-worker-node.js";
+        |]
+  | _ -> Vec.empty
+
+let db_worker_runtime_script_path () =
+  match env_db_worker_script_path () with
+  | Some path -> path
+  | None -> (
+      match
+        Vec.find_opt Cli_unix.file_exists (cli_dir_db_worker_script_paths ())
+      with
+      | Some path -> path
+      | None -> "db-worker-node.js")
+
+let starts_with ~prefix value =
+  let prefix_len = String.length prefix in
+  String.length value >= prefix_len && String.sub value 0 prefix_len = prefix
+
+let server_list_path config =
+  Filename.concat (resolve_root_dir config) "server-list"
+
+let repo_identity repo = Cli_config.repo_to_graph repo
+let same_repo a b = repo_identity a = repo_identity b
+
+let process_alive pid =
+  try
+    Cli_unix.kill pid 0;
+    true
+  with
+  | Cli_unix.Cli_unix_error (Cli_unix.ESRCH, _, _) -> false
+  | Cli_unix.Cli_unix_error (Cli_unix.EPERM, _, _) -> true
+
+let http_request ~(method_ : Fetch.requestMethod) ~url ~headers ~body
+    ~timeout_span =
+  Cli_platform.HTTP.request ?timeout_span method_ url ~headers ~body
+  >>= fun (response, body) -> Cli_effect.pure (response, body)
+
+let http_success response =
+  let status = Fetch.Response.status response in
+  status >= 200 && status < 300
+
+let http_health_response response =
+  let status = Fetch.Response.status response in
+  status = 200 || status = 503
+
+let server_publish_timeout_span = Time.span_of_ms 30_000L
+let server_ready_timeout_span = Time.span_of_ms 30_000L
+
+let parse_server_list_line line =
+  match Vec.split_on_char ' ' (String.trim line) |> Vec.filter (( <> ) "") with
+  | values when Vec.length values = 2 -> (
+      let pid = Vec.nth values 0 in
+      let port = Vec.nth values 1 in
+      match (int_of_string_opt pid, int_of_string_opt port) with
+      | Some pid, Some port when pid > 0 && port > 0 -> Some (pid, port)
+      | _ -> None)
+  | _ -> None
+
+let read_server_list path =
+  if not (Cli_unix.file_exists path) then Vec.empty
+  else
+    Cli_unix.read_text_file path
+    |> Vec.split_on_char '\n'
+    |> Vec.filter_map parse_server_list_line
+
+let status_of_string = function
+  | "ready" -> Ready
+  | "starting" -> Starting
+  | "error" -> Error
+  | _ -> Unknown
+
+let owner_source_of_string = function
+  | "cli" -> Cli_primitive.Cli
+  | "electron" -> Electron
+  | _ -> Unknown
+
+let server_of_health ~fallback_port body =
+  let raw = Json_util.value_of_json_string body in
+  let repo =
+    Edn_util.get_string raw "repo"
+    |> Option.value ~default:"" |> Cli_primitive.create_repo
+  in
+  let host =
+    Edn_util.get_string raw "host" |> Option.value ~default:"127.0.0.1"
+  in
+  let port =
+    Edn_util.get_int raw "port" |> Option.value ~default:fallback_port
+  in
+  let pid = Edn_util.get_int raw "pid" |> Option.value ~default:0 in
+  let status =
+    Edn_util.get_string raw "status"
+    |> Option.map status_of_string
+    |> Option.value ~default:Unknown
+  in
+  let owner_source =
+    Edn_util.get_string raw "owner-source"
+    |> Option.map owner_source_of_string
+    |> Option.value ~default:Cli_primitive.Unknown
+  in
+  {
+    repo;
+    graph = Some (Cli_config.repo_to_graph repo);
+    pid;
+    host;
+    port;
+    base_url = "http://" ^ host ^ ":" ^ string_of_int port;
+    status;
+    revision = Edn_util.get_string raw "revision";
+    root_dir = Edn_util.get_string raw "root-dir";
+    owner_source;
+    owned = owner_source = Cli_primitive.Cli || owner_source = Unknown;
+    raw = Some raw;
+  }
+
+let discover_server (_pid, port) =
+  Cli_effect.catch
+    (Cli_effect.map
+       (fun (response, body) ->
+         if http_health_response response then
+           Some (server_of_health ~fallback_port:port body)
+         else None)
+       (http_request ~method_:Fetch.Get
+          ~url:("http://127.0.0.1:" ^ string_of_int port ^ "/healthz")
+          ~headers:(Vec.singleton ("Accept", "application/json"))
+          ~body:""
+          ~timeout_span:(Some (Time.span_of_ms 1_000L))))
+    (fun _ -> Cli_effect.pure None)
+
+let list_servers config =
+  let entries =
+    read_server_list (server_list_path config)
+    |> Vec.filter (fun (pid, _) -> process_alive pid)
+  in
+  Cli_effect.map (Vec.filter_map Fun.id)
+    (Cli_effect.all (Vec.map discover_server entries))
+
+let rec mkdir_p path =
+  if path = "" || path = Filename.dirname path || Cli_unix.file_exists path then
+    ()
+  else (
+    mkdir_p (Filename.dirname path);
+    Cli_unix.mkdir path 0o755)
+
+let ensure_repo_dir config repo =
+  let path =
+    Filename.concat (graphs_dir config) (Graph_dir.graph_dir_name_of_repo repo)
+  in
+  try
+    mkdir_p path;
+    if not (Cli_unix.is_directory path) then
+      Stdlib.Error
+        (Error.make Error.Root_dir_permission
+           ("graph-dir is not a directory: " ^ path))
+    else Stdlib.Ok path
+  with exn ->
+    Stdlib.Error
+      (Error.make Error.Root_dir_permission
+         ("graph-dir is not readable/writable: " ^ path ^ " ("
+        ^ Printexc.to_string exn ^ ")"))
+
+let script_candidates config =
+  let project_dir = config.Cli_config.project_dir in
+  let project_candidates =
+    match project_dir with
+    | None -> Vec.empty
+    | Some dir ->
+        Vec.of_array
+          [|
+            Filename.concat (Filename.concat dir "static") "db-worker-node.js";
+            Filename.concat (Filename.concat dir "dist") "db-worker-node.js";
+            Filename.concat
+              (Filename.concat (Filename.concat dir "static") "js")
+              "db-worker-node.js";
+          |]
+  in
+  Vec.filter_map Fun.id (Vec.singleton (env_db_worker_script_path ()))
+  |> fun candidates ->
+  Vec.append candidates (cli_dir_db_worker_script_paths ()) |> fun candidates ->
+  Vec.push_back candidates "db-worker-node.js" |> fun candidates ->
+  Vec.append candidates project_candidates
+
+let resolve_script_path config =
+  let candidates = script_candidates config in
+  match Vec.find_opt Cli_unix.file_exists candidates with
+  | Some path -> Stdlib.Ok path
+  | None ->
+      Stdlib.Error
+        (Error.make
+           ~context:
+             (Edn_util.vector_vec
+                (candidates |> Vec.map (fun path -> Edn_util.string path)))
+           Error.Server_script_missing
+           ("db-worker script is missing. Checked paths: "
+           ^ Vec.string_concat ", " candidates))
+
+let env_with_node_runtime () =
+  let without_key key =
+    Cli_unix.environment () |> Vec.of_array
+    |> Vec.filter (fun entry ->
+        let prefix = key ^ "=" in
+        not (starts_with ~prefix entry))
+  in
+  Vec.push_front (without_key "ELECTRON_RUN_AS_NODE") "ELECTRON_RUN_AS_NODE=1"
+  |> Vec.to_array
+
+let db_worker_spawn_args ~executable ~script ~root_dir ~repo ~owner_source
+    ~create_empty_db =
+  let repo = Cli_primitive.string_of_repo repo in
+  let args =
+    Vec.of_array
+      [|
+        executable;
+        script;
+        "--repo";
+        repo;
+        "--root-dir";
+        root_dir;
+        "--owner-source";
+        owner_source;
+      |]
+  in
+  if create_empty_db then Vec.push_back args "--create-empty-db" else args
+
+let shell_quote value =
+  let rec needs_quote i =
+    i < String.length value
+    &&
+    match value.[i] with
+    | ' ' | '\t' | '\n' | '\'' | '"' | '\\' -> true
+    | _ -> needs_quote (i + 1)
+  in
+  if value <> "" && not (needs_quote 0) then value
+  else "'" ^ Vec.string_concat "'\\''" (Vec.split_on_char '\'' value) ^ "'"
+
+let db_worker_command_line ~script ~root_dir ~repo ~owner_source
+    ~create_empty_db =
+  let executable = parent_executable_path () in
+  Vec.push_front
+    (db_worker_spawn_args ~executable ~script ~root_dir ~repo ~owner_source
+       ~create_empty_db)
+    "ELECTRON_RUN_AS_NODE=1"
+  |> Vec.map shell_quote |> Vec.string_concat " "
+
+let spawn_server_process ~script ~root_dir ~repo ~owner_source ~create_empty_db
+    =
+  let devnull =
+    Cli_unix.openfile "/dev/null" (Vec.singleton Cli_unix.O_RDWR) 0
+  in
+  Fun.protect
+    ~finally:(fun () -> Cli_unix.close devnull)
+    (fun () ->
+      let executable = parent_executable_path () in
+      let argv =
+        db_worker_spawn_args ~executable ~script ~root_dir ~repo ~owner_source
+          ~create_empty_db
+        |> Vec.to_array
+      in
+      ignore
+        (Cli_unix.create_process_env executable argv (env_with_node_runtime ())
+           devnull devnull devnull))
+
+let find_repo_server config repo =
+  Cli_effect.map
+    (Vec.find_opt (fun (server : server) -> same_repo server.repo repo))
+    (list_servers config)
+
+let invoke_config_of_server config server =
+  {
+    Transport.base_url = server.base_url;
+    timeout_span = config.Cli_config.timeout_span;
+    profile_session = config.profile_session;
+  }
+
+let wait_until_effect ?(timeout_span = Time.span_of_ms 8_000L)
+    ?(interval_span = Time.span_of_ms 50L) predicate =
+  let open Cli_effect in
+  let deadline =
+    Option.value
+      (Time.add_span (Time.now ()) timeout_span)
+      ~default:Time.max_time
+  in
+  let rec loop () =
+    bind (predicate ()) (function
+      | Some _ as result -> pure result
+      | None ->
+          if Time.compare_time (Time.now ()) deadline >= 0 then pure None
+          else bind (sleep interval_span) (fun () -> loop ()))
+  in
+  loop ()
+
+let wait_for_lock path =
+  wait_until_effect (fun () ->
+      Cli_effect.pure (if Cli_unix.file_exists path then Some () else None))
+
+let wait_for_ready config repo =
+  wait_until_effect ~timeout_span:server_ready_timeout_span (fun () ->
+      Cli_effect.map
+        (function
+          | Some ({ status = Ready; _ } as server) -> Some server | _ -> None)
+        (find_repo_server config repo))
+
+let read_lock_pid path =
+  if not (Cli_unix.file_exists path) then None
+  else
+    try
+      Cli_unix.read_text_file path |> Json_util.value_of_json_string
+      |> fun raw -> Edn_util.get_int raw "pid"
+    with _ -> None
+
+let live_lock path =
+  match read_lock_pid path with Some pid -> process_alive pid | None -> false
+
+let owner_manageable = function
+  | Cli_primitive.Cli | Cli_primitive.Unknown -> true
+  | _ -> false
+
+let start_result_of_server repo (server : server) =
+  { repo; owner_source = server.owner_source; owned = server.owned }
+
+let wait_for_published_ready time config repo =
+  let open Cli_effect in
+  bind
+    (time "server.wait-publish" (fun () ->
+         wait_until_effect ~timeout_span:server_publish_timeout_span (fun () ->
+             find_repo_server config repo)))
+    (function
+      | None ->
+          pure
+            (Stdlib.Error
+               (Error.make Error.Server_start_failed
+                  "db-worker-node failed to publish health"))
+      | Some _ ->
+          bind
+            (time "server.wait-ready" (fun () -> wait_for_ready config repo))
+            (function
+              | Some server ->
+                  pure (Stdlib.Ok (start_result_of_server repo server))
+              | None ->
+                  pure
+                    (Stdlib.Error
+                       (Error.make Error.Server_start_failed
+                          "db-worker-node failed to start"))))
+
+let start_server_unprofiled config repo ~create_empty_db =
+  let open Cli_effect in
+  let time stage f =
+    Profile_types.time config.Cli_config.profile_session stage f
+  in
+  bind (find_repo_server config repo) (function
+    | Some ({ status = Ready; _ } as server) ->
+        pure (Stdlib.Ok (start_result_of_server repo server))
+    | Some _ -> wait_for_published_ready time config repo
+    | None when Option.is_some config.Cli_config.base_url ->
+        pure
+          (Stdlib.Ok { repo; owner_source = config.owner_source; owned = false })
+    | None -> (
+        match ensure_repo_dir config repo with
+        | Stdlib.Error err -> pure (Stdlib.Error err)
+        | Stdlib.Ok _ -> (
+            let lock = lock_path ~root_dir:(resolve_root_dir config) repo in
+            if live_lock lock then wait_for_published_ready time config repo
+            else
+              match resolve_script_path config with
+              | Stdlib.Error err -> pure (Stdlib.Error err)
+              | Stdlib.Ok script -> (
+                  try
+                    bind
+                      (time "server.spawn-daemon" (fun () ->
+                           spawn_server_process ~script
+                             ~root_dir:(resolve_root_dir config) ~repo
+                             ~owner_source:"cli" ~create_empty_db;
+                           pure ()))
+                      (fun () ->
+                        bind
+                          (time "server.wait-lock" (fun () ->
+                               wait_for_lock lock))
+                          (function
+                            | None ->
+                                pure
+                                  (Stdlib.Error
+                                     (Error.make
+                                        Error.Server_start_timeout_orphan
+                                        ("db-worker-node failed to start. \
+                                          Command: "
+                                        ^ db_worker_command_line ~script
+                                            ~root_dir:(resolve_root_dir config)
+                                            ~repo ~owner_source:"cli"
+                                            ~create_empty_db)))
+                            | Some () ->
+                                wait_for_published_ready time config repo))
+                  with exn ->
+                    pure
+                      (Stdlib.Error
+                         (Error.make Error.Server_start_failed
+                            ("failed to spawn db-worker-node: "
+                           ^ Printexc.to_string exn)))))))
+
+let start_server config repo ~create_empty_db =
+  Profile_types.time config.Cli_config.profile_session "server.ensure-started"
+    (fun () -> start_server_unprofiled config repo ~create_empty_db)
+
+let ensure_server config repo ~create_empty_db =
+  match config.Cli_config.base_url with
+  | Some base_url ->
+      Cli_effect.pure
+        (Ok
+           {
+             Transport.base_url;
+             timeout_span = config.timeout_span;
+             profile_session = config.profile_session;
+           })
+  | None ->
+      let open Cli_effect in
+      bind (find_repo_server config repo) (function
+        | Some ({ status = Ready; _ } as server) ->
+            pure (Ok (invoke_config_of_server config server))
+        | Some _ ->
+            bind (wait_for_ready config repo) (function
+              | Some server -> pure (Ok (invoke_config_of_server config server))
+              | None ->
+                  pure
+                    (Stdlib.Error
+                       (Error.make Error.Server_start_failed
+                          "db-worker-node failed to start")))
+        | None ->
+            bind (start_server config repo ~create_empty_db) (function
+              | Stdlib.Error err -> pure (Stdlib.Error err)
+              | Stdlib.Ok _ ->
+                  bind (wait_for_ready config repo) (function
+                    | Some server ->
+                        pure (Ok (invoke_config_of_server config server))
+                    | None ->
+                        pure
+                          (Stdlib.Error
+                             (Error.make Error.Server_start_failed
+                                "db-worker-node failed to publish health")))))
+
+let shutdown_server server =
+  Cli_effect.catch
+    (Cli_effect.map
+       (fun (response, _body) -> http_success response)
+       (http_request ~method_:Fetch.Post
+          ~url:(server.base_url ^ "/v1/shutdown")
+          ~headers:(Vec.singleton ("Content-Type", "application/json"))
+          ~body:"{}"
+          ~timeout_span:(Some (Time.span_of_ms 1_000L))))
+    (fun _ -> Cli_effect.pure false)
+
+let stop_server config repo =
+  let open Cli_effect in
+  bind (find_repo_server config repo) (function
+    | None when Option.is_some config.Cli_config.base_url ->
+        pure (Stdlib.Ok { repo })
+    | None ->
+        pure
+          (Stdlib.Error
+             (Error.make Error.Server_not_found "server is not running"))
+    | Some server ->
+        if not (owner_manageable server.owner_source) then
+          pure
+            (Stdlib.Error
+               (Error.make Error.Server_owned_by_other
+                  "server is owned by another process"))
+        else
+          let shutdown_timeout_span = Time.span_of_ms 5_000L in
+          let shutdown_interval_span = Time.span_of_ms 200L in
+          let kill_timeout_span = Time.span_of_ms 1_000L in
+          let kill_interval_span = Time.span_of_ms 100L in
+          bind (shutdown_server server) (fun _ ->
+              bind
+                (wait_until_effect ~timeout_span:shutdown_timeout_span
+                   ~interval_span:shutdown_interval_span (fun () ->
+                     map
+                       (function None -> Some () | Some _ -> None)
+                       (find_repo_server config repo)))
+                (function
+                  | Some () -> pure (Stdlib.Ok { repo })
+                  | None ->
+                      (try
+                         if process_alive server.pid then
+                           Cli_unix.kill server.pid Sys.sigterm
+                       with _ -> ());
+                      bind
+                        (wait_until_effect ~timeout_span:kill_timeout_span
+                           ~interval_span:kill_interval_span (fun () ->
+                             map
+                               (function None -> Some () | Some _ -> None)
+                               (find_repo_server config repo)))
+                        (function
+                          | Some () -> pure (Stdlib.Ok { repo })
+                          | None ->
+                              pure
+                                (Stdlib.Error
+                                   (Error.make Error.Server_stop_timeout
+                                      "timed out stopping server"))))))
+
+let restart_server config repo =
+  stop_server config repo >>= function
+  | Stdlib.Ok _ -> start_server config repo ~create_empty_db:false
+  | Stdlib.Error err when err.code = Error.Server_not_found ->
+      start_server config repo ~create_empty_db:false
+  | Stdlib.Error err -> Cli_effect.pure (Stdlib.Error err)
+
+let ignored_graph_dir name =
+  name = "Unlinked graphs" || name = "backup"
+  || starts_with ~prefix:"file-version-" name
+  || starts_with ~prefix:"logseq_db_" name
+
+let contains_substring ~needle text =
+  let needle_len = String.length needle in
+  let text_len = String.length text in
+  let rec loop index =
+    index + needle_len <= text_len
+    && (String.sub text index needle_len = needle || loop (index + 1))
+  in
+  needle_len = 0 || loop 0
+
+let legacy_derivation_signal dir_name =
+  contains_substring ~needle:"++" dir_name
+  || contains_substring ~needle:"+3A+" dir_name
+  || contains_substring ~needle:"%" dir_name
+
+let decode_legacy_graph_dir_name dir_name =
+  if not (legacy_derivation_signal dir_name) then None
+  else Graph_dir.decode_legacy_graph_dir_name dir_name
+
+let canonical_graph_name graph =
+  if graph <> "" && not (starts_with ~prefix:"logseq_db_" graph) then Some graph
+  else None
+
+let classify_graph_dir graphs_root dir_name =
+  if ignored_graph_dir dir_name then None
+  else
+    match
+      Option.bind
+        (Graph_dir.canonical_graph_name_of_dir dir_name)
+        canonical_graph_name
+    with
+    | Some graph_name ->
+        Some
+          {
+            Graph_types.kind = Graph_types.Canonical;
+            graph_name = Some (Cli_primitive.create_graph graph_name);
+            graph_dir = Some dir_name;
+            legacy_dir = None;
+            target_graph_dir = None;
+            conflict = false;
+            reason = None;
+          }
+    | None -> (
+        match
+          Option.bind
+            (decode_legacy_graph_dir_name dir_name)
+            canonical_graph_name
+        with
+        | Some graph_name ->
+            let target_graph_dir = Graph_dir.encode_graph_dir_name graph_name in
+            Some
+              {
+                Graph_types.kind = Graph_types.Legacy;
+                graph_name = Some (Cli_primitive.create_graph graph_name);
+                graph_dir = None;
+                legacy_dir = Some dir_name;
+                target_graph_dir = Some target_graph_dir;
+                conflict =
+                  target_graph_dir <> dir_name
+                  && Cli_unix.file_exists
+                       (Filename.concat graphs_root target_graph_dir);
+                reason = None;
+              }
+        | None ->
+            if legacy_derivation_signal dir_name then
+              Some
+                {
+                  Graph_types.kind = Graph_types.Legacy_undecodable;
+                  graph_name = None;
+                  graph_dir = None;
+                  legacy_dir = Some dir_name;
+                  target_graph_dir = None;
+                  conflict = false;
+                  reason = Some (Edn_util.keyword_t "graph-name-not-derivable");
+                }
+            else None)
+
+let list_graph_items config =
+  let dir = graphs_dir config in
+  if Cli_unix.file_exists dir then
+    Cli_unix.readdir dir |> Vec.of_array
+    |> Vec.filter (fun name -> Cli_unix.is_directory (Filename.concat dir name))
+    |> Vec.sort_uniq String.compare
+    |> Vec.filter_map (classify_graph_dir dir)
+  else Vec.empty
+
+let list_graphs config =
+  list_graph_items config
+  |> Vec.filter_map (function
+    | { Graph_types.kind = Graph_types.Canonical; graph_name = Some graph; _ }
+      ->
+        Some graph
+    | _ -> None)
+
+let revision_matches cli_revision server =
+  match server.revision with
+  | Some revision -> String.equal revision cli_revision
+  | None -> false
+
+let cleanup_revision_mismatched_servers config ~cli_revision =
+  let open Cli_effect in
+  bind (list_servers config) (fun servers ->
+      let mismatched =
+        Vec.filter
+          (fun server -> not (revision_matches cli_revision server))
+          servers
+      in
+      let eligible, skipped =
+        Vec.partition
+          (fun (server : server) -> server.owner_source = Cli_primitive.Cli)
+          mismatched
+      in
+      let rec stop_loop killed failed targets =
+        match Vec.pop_front targets with
+        | None ->
+            pure
+              (Ok
+                 {
+                   cli_revision;
+                   checked = Vec.length servers;
+                   mismatched = Vec.length mismatched;
+                   eligible = Vec.length eligible;
+                   skipped_owner = Vec.length skipped;
+                   killed;
+                   failed;
+                 })
+        | Some (server, rest) ->
+            bind (shutdown_server server) (fun stopped ->
+                if stopped then
+                  stop_loop (Vec.push_back killed server) failed rest
+                else
+                  stop_loop killed
+                    (Vec.push_back failed
+                       ( server,
+                         Error.make Error.Server_cleanup_failed
+                           "failed to stop revision-mismatched server" ))
+                    rest)
+      in
+      stop_loop Vec.empty Vec.empty eligible)

cli/lib/sha256.ml

@@ -0,0 +1,3 @@
+let hex = Cli_platform.Crypto.sha256_hex
+let base64url = Cli_platform.Crypto.sha256_base64url
+let file_hex path = Cli_unix.read_binary_file path |> hex

cli/lib/skill.ml

@@ -0,0 +1,249 @@
+type install_opts = { global : bool }
+type parsed = Parsed_show | Parsed_install of install_opts
+
+type action =
+  | Skill_show of { source_path : Cli_primitive.path option }
+  | Skill_install of {
+      global : bool;
+      source_path : Cli_primitive.path option;
+      destination_dir : Cli_primitive.path option;
+      destination_file : Cli_primitive.path option;
+    }
+
+type install_target = {
+  scope : Cli_primitive.keyword;
+  path : Cli_primitive.path;
+  update_command : string;
+}
+
+type update_status = {
+  installed : bool;
+  outdated : bool;
+  outdated_targets : install_target Rrbvec.t;
+  error : Error.t option;
+}
+
+let skill_dir_name = "logseq-cli"
+let skill_file_name = "SKILL.md"
+
+let skill_file_under base =
+  Filename.concat
+    (Filename.concat
+       (Filename.concat (Filename.concat base ".agents") "skills")
+       skill_dir_name)
+    skill_file_name
+
+external process_argv : string array = "argv" [@@mel.module "process"]
+
+let executable_dir_candidates () =
+  let candidates_for_script script =
+    let script_dir = Filename.dirname script in
+    Vec.of_array
+      [|
+        skill_file_under script_dir;
+        skill_file_under (Filename.dirname script_dir);
+      |]
+  in
+  if Array.length process_argv >= 2 then candidates_for_script process_argv.(1)
+  else if Array.length process_argv = 1 then
+    candidates_for_script process_argv.(0)
+  else Vec.empty
+
+let non_empty value =
+  match Option.map String.trim value with
+  | Some "" | None -> None
+  | Some value -> Some value
+
+let resolve_install_target ~global ~cwd ~home_dir =
+  match (global, non_empty home_dir) with
+  | true, None ->
+      Error
+        (Error.make Error.Skill_home_dir_unavailable
+           "home directory is unavailable; cannot resolve --global install \
+            target")
+  | _ ->
+      let base =
+        if global then Option.value (non_empty home_dir) ~default:cwd else cwd
+      in
+      Ok
+        {
+          scope = Edn_util.keyword_t (if global then "global" else "local");
+          path = skill_file_under base;
+          update_command =
+            (if global then "logseq skill install --global"
+             else "logseq skill install");
+        }
+
+let installed_skill_targets ~cwd ~home_dir =
+  let local = resolve_install_target ~global:false ~cwd ~home_dir in
+  let global = resolve_install_target ~global:true ~cwd ~home_dir in
+  Vec.of_array [| local; global |]
+  |> Vec.filter_map (function Ok target -> Some target | Error _ -> None)
+
+let read_file = Cli_unix.read_text_file
+
+let rec mkdir_p path =
+  if path = "" || path = Filename.dirname path || Cli_unix.file_exists path then
+    ()
+  else (
+    mkdir_p (Filename.dirname path);
+    Cli_unix.mkdir path 0o755)
+
+let write_file path content =
+  mkdir_p (Filename.dirname path);
+  Cli_unix.write_text_file path content
+
+let default_source_candidates config =
+  let executable = executable_dir_candidates () in
+  let project =
+    match config.Cli_config.project_dir with
+    | Some project_dir -> Vec.singleton (skill_file_under project_dir)
+    | None -> Vec.empty
+  in
+  let home =
+    match Sys.getenv_opt "HOME" with
+    | Some home -> Vec.singleton (skill_file_under home)
+    | None -> Vec.empty
+  in
+  Vec.append executable project |> fun candidates ->
+  Vec.append candidates home |> fun candidates ->
+  Vec.push_back candidates (skill_file_under (Sys.getcwd ()))
+
+let resolve_source_path ?source_path config =
+  match non_empty source_path with
+  | Some path when Cli_unix.file_exists path -> Ok path
+  | Some path ->
+      Error
+        (Error.make
+           ~context:
+             (Edn_util.vector_vec (Vec.of_array [| Edn_util.string path |]))
+           Error.Skill_source_not_found
+           ("skill source file not found: " ^ path))
+  | None -> (
+      let candidates = default_source_candidates config in
+      match Vec.find_opt Cli_unix.file_exists candidates with
+      | Some path -> Ok path
+      | None ->
+          Error
+            (Error.make
+               ~context:
+                 (Edn_util.vector_vec
+                    (candidates |> Vec.map (fun path -> Edn_util.string path)))
+               Error.Skill_source_not_found
+               ("skill source file not found. Checked paths: "
+               ^ Vec.string_concat ", " candidates)))
+
+let command_id = function
+  | Parsed_show -> Command_id.Skill_show
+  | Parsed_install _ -> Skill_install
+
+let validate_parsed _ = Ok ()
+
+let build ?registry:_ config _globals = function
+  | Parsed_show -> Ok (Skill_show { source_path = None })
+  | Parsed_install { global } ->
+      let cwd =
+        Option.value config.Cli_config.project_dir ~default:(Sys.getcwd ())
+      in
+      let home_dir = Sys.getenv_opt "HOME" in
+      Error.bind (resolve_install_target ~global ~cwd ~home_dir) (fun target ->
+          Ok
+            (Skill_install
+               {
+                 global;
+                 source_path = None;
+                 destination_dir = Some (Filename.dirname target.path);
+                 destination_file = Some target.path;
+               }))
+
+let target_from_action config global destination_dir destination_file =
+  match (destination_dir, destination_file) with
+  | Some dir, Some file -> Ok (dir, file)
+  | _ ->
+      let cwd =
+        Option.value config.Cli_config.project_dir ~default:(Sys.getcwd ())
+      in
+      Error.bind
+        (resolve_install_target ~global ~cwd ~home_dir:(Sys.getenv_opt "HOME"))
+        (fun target -> Ok (Filename.dirname target.path, target.path))
+
+let execute_show config mode source_path =
+  let command = Command_id.Skill_show in
+  match resolve_source_path ?source_path config with
+  | Error err -> Cli_effect.pure (Output_mode.error ~command mode err)
+  | Ok path -> (
+      match read_file path with
+      | content ->
+          Cli_effect.pure (Cli_result.ok ~command mode (Message content))
+      | exception exn ->
+          Cli_effect.pure
+            (Output_mode.error ~command mode
+               (Error.make Error.Skill_show_failed
+                  ("failed to read skill source: " ^ Printexc.to_string exn))))
+
+let install_value ~source ~file =
+  Edn_util.map_vec
+    (Vec.of_array
+       [|
+         (Edn_util.keyword "source-path", Edn_util.string source);
+         (Edn_util.keyword "installed-path", Edn_util.string file);
+         ( Edn_util.keyword "message",
+           Edn_util.string ("Installed skill to " ^ file) );
+       |])
+
+let execute_install config mode ~global ~source_path ~destination_dir
+    ~destination_file =
+  let command = Command_id.Skill_install in
+  match resolve_source_path ?source_path config with
+  | Error err -> Cli_effect.pure (Output_mode.error ~command mode err)
+  | Ok source -> (
+      match
+        target_from_action config global destination_dir destination_file
+      with
+      | Error err -> Cli_effect.pure (Output_mode.error ~command mode err)
+      | Ok (dir, file) -> (
+          try
+            if Cli_unix.file_exists dir && not (Cli_unix.is_directory dir) then
+              raise (Invalid_argument ("destination path is a file: " ^ dir));
+            let content = read_file source in
+            write_file file content;
+            Cli_effect.pure
+              (Cli_result.ok ~command mode (Raw (install_value ~source ~file)))
+          with exn ->
+            Cli_effect.pure
+              (Output_mode.error ~command mode
+                 (Error.make Error.Skill_install_failed
+                    ("failed to install skill: " ^ Printexc.to_string exn)))))
+
+let execute_with_mode action config mode =
+  match action with
+  | Skill_show { source_path } -> execute_show config mode source_path
+  | Skill_install { global; source_path; destination_dir; destination_file } ->
+      execute_install config mode ~global ~source_path ~destination_dir
+        ~destination_file
+
+let meta id doc =
+  {
+    Command_registry.id;
+    path = Command_id.to_path id;
+    doc;
+    long_doc = None;
+    examples = Vec.empty;
+    options = Vec.empty;
+    category = Command_registry.Utilities;
+    requires_graph = Command_id.requires_graph id;
+    requires_auth = Command_id.requires_auth id;
+    write_command = Command_id.is_write id;
+    human_table_headers_order = Vec.empty;
+  }
+
+let metadata () =
+  Vec.of_array
+    [|
+      meta Command_id.Skill_show "Show built-in logseq-cli skill";
+      meta Skill_install "Install built-in logseq-cli skill";
+    |]
+
+let execute action config =
+  let (Output.Mode.Packed mode) = Output_mode.for_config config in
+  execute_with_mode action config mode

cli/lib/task_status.ml

@@ -0,0 +1,129 @@
+type status = { ident : Cli_primitive.keyword; value : string }
+
+let kw value = Edn_util.keyword value
+let sym value = Edn_util.symbol value
+let vector_vec values = Edn_util.vector_vec values
+let vector_t_vec values = Edn_util.vector_t_vec values
+
+let status_closed_values_query =
+  Cli_primitive.(
+    make_datascript_query
+      ~find:
+        (Vec.singleton
+           (vector_vec (Vec.of_array [| sym "?status-ident"; sym "..." |])))
+      ~where:
+        (Vec.of_array
+           [|
+             V
+               (vector_t_vec
+                  (Vec.of_array
+                     [|
+                       sym "?property";
+                       kw "db/ident";
+                       kw "logseq.property/status";
+                     |]));
+             V
+               (vector_t_vec
+                  (Vec.of_array
+                     [|
+                       sym "?value";
+                       kw "block/closed-value-property";
+                       sym "?property";
+                     |]));
+             V
+               (vector_t_vec
+                  (Vec.of_array
+                     [| sym "?value"; kw "db/ident"; sym "?status-ident" |]));
+           |])
+      ()
+    |> datascript_query_to_edn)
+
+let starts_with ~prefix value =
+  let prefix_len = String.length prefix in
+  String.length value >= prefix_len && String.sub value 0 prefix_len = prefix
+
+let drop_prefix prefix value =
+  if starts_with ~prefix value then
+    String.sub value (String.length prefix)
+      (String.length value - String.length prefix)
+  else value
+
+let normalize_token value =
+  value |> String.trim |> String.lowercase_ascii |> drop_prefix ":"
+  |> drop_prefix "logseq.property/status."
+  |> drop_prefix "status."
+  |> String.map (function ' ' | '_' -> '-' | c -> c)
+
+let status_value_of_ident ident =
+  ident |> drop_prefix ":"
+  |> drop_prefix "logseq.property/status."
+  |> drop_prefix "status." |> normalize_token
+
+let keyword_of_string value = Edn_util.keyword_t value
+
+let status_of_value value =
+  match Edn_util.as_string_like value with
+  | Some ident ->
+      let value = status_value_of_ident ident in
+      if value = "" || value = ident then None
+      else Some { ident = keyword_of_string ident; value }
+  | None -> (
+      match Edn_util.as_map value with
+      | None -> None
+      | Some fields -> (
+          let value_of_key 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 ident =
+            match
+              Option.bind (value_of_key "ident") Edn_util.as_string_like
+            with
+            | Some ident -> Some (keyword_of_string ident)
+            | None -> None
+          in
+          let value =
+            match
+              Option.bind (value_of_key "value") Edn_util.as_string_like
+            with
+            | Some value -> Some (normalize_token value)
+            | _ ->
+                Option.map
+                  (fun ident ->
+                    status_value_of_ident (Edn_util.keyword_to_string ident))
+                  ident
+          in
+          match (ident, value) with
+          | Some ident, Some value when value <> "" -> Some { ident; value }
+          | _ -> None))
+
+let normalize_available_statuses values =
+  values
+  |> Vec.filter_map status_of_value
+  |> Vec.sort (fun a b -> compare (a.value, a.ident) (b.value, b.ident))
+
+let resolve_status_ident value statuses =
+  let token = normalize_token value in
+  let ident_from_token =
+    keyword_of_string ("logseq.property/status." ^ token)
+  in
+  statuses
+  |> Vec.find_map (fun s ->
+      if
+        s.value = token
+        || s.ident = keyword_of_string value
+        || s.ident = ident_from_token
+      then Some s.ident
+      else None)
+
+let invalid_status_message value statuses =
+  let available =
+    statuses |> Vec.map (fun s -> s.value) |> Vec.string_concat ", "
+  in
+  let available = if available = "" then "(none)" else available in
+  "Invalid value for option :status: " ^ value ^ ". Available values: "
+  ^ available

cli/lib/time.ml

@@ -0,0 +1,89 @@
+type span = float
+type date = Js.Date.t
+
+let finite value =
+  match classify_float value with FP_nan | FP_infinite -> false | _ -> true
+
+let invalid_time () = invalid_arg "invalid POSIX timestamp"
+let invalid_span () = invalid_arg "invalid POSIX time span"
+
+let time_of_epoch_ms_float ms =
+  if finite ms then
+    let time = Js.Date.fromFloat ms in
+    if finite (Js.Date.getTime time) then time else invalid_time ()
+  else invalid_time ()
+
+let now () = Js.Date.make ()
+let epoch = time_of_epoch_ms_float 0.
+let max_time = time_of_epoch_ms_float 8_640_000_000_000_000.
+let time_of_epoch_ms ms = time_of_epoch_ms_float (Int64.to_float ms)
+let time_to_epoch_ms time = Int64.of_float (Js.Date.getTime time)
+let time_to_epoch_seconds time = Int64.of_float (Js.Date.getTime time /. 1000.)
+let time_to_epoch_seconds_float time = Js.Date.getTime time /. 1000.
+
+let compare_time left right =
+  Float.compare (Js.Date.getTime left) (Js.Date.getTime right)
+
+let span_of_ms ms =
+  let span = Int64.to_float ms in
+  if finite span then span else invalid_span ()
+
+let span_to_ms span = Int64.of_float span
+let zero_span = 0.
+let compare_span = Float.compare
+let add_span_value left right = left +. right
+
+let add_span time span =
+  let ms = Js.Date.getTime time +. span in
+  if finite ms then Some (Js.Date.fromFloat ms) else None
+
+let local_date time =
+  ( int_of_float (Js.Date.getFullYear time),
+    int_of_float (Js.Date.getMonth time) + 1,
+    int_of_float (Js.Date.getDate time) )
+
+let utc_date_time time =
+  ( int_of_float (Js.Date.getUTCFullYear time),
+    int_of_float (Js.Date.getUTCMonth time) + 1,
+    int_of_float (Js.Date.getUTCDate time),
+    int_of_float (Js.Date.getUTCHours time),
+    int_of_float (Js.Date.getUTCMinutes time),
+    int_of_float (Js.Date.getUTCSeconds time) )
+
+let non_negative_diff ~start_time ~end_time =
+  max 0. (Js.Date.getTime end_time -. Js.Date.getTime start_time)
+
+let avg_span span count =
+  if count <= 0 then zero_span else span /. float_of_int count
+
+let rfc3339_millis time = Js.Date.toISOString time
+
+let valid_parsed_ms ms =
+  try Some (time_of_epoch_ms_float ms) with Invalid_argument _ -> None
+
+let parse_rfc3339 text =
+  let valid_shape =
+    String.length text >= 20
+    && text.[4] = '-'
+    && text.[7] = '-'
+    && (text.[10] = 'T' || text.[10] = 't')
+    && text.[13] = ':'
+    && text.[16] = ':'
+  in
+  if valid_shape then valid_parsed_ms (Js.Date.parseAsFloat text) else None
+
+let parse_date_as_utc text =
+  if String.length text = 10 && text.[4] = '-' && text.[7] = '-' then
+    parse_rfc3339 (text ^ "T00:00:00Z")
+  else None
+
+let parse_time text =
+  let text = String.trim text in
+  if text = "" then None
+  else
+    match parse_rfc3339 text with
+    | Some _ as time -> time
+    | None -> (
+        match Int64.of_string_opt text with
+        | Some ms -> Some (time_of_epoch_ms ms)
+        | None -> parse_date_as_utc text)

cli/lib/transport.ml

@@ -0,0 +1,431 @@
+open Cli_effect.Infix
+
+type invoke_config = {
+  base_url : Cli_primitive.url;
+  timeout_span : float;
+  profile_session : Profile_types.session option;
+}
+
+type event_type = Cli_primitive.keyword
+type event_payload = Melange_edn_melange.any
+type event_subscription = { close : unit -> unit Cli_effect.t }
+
+let thread_api_method name = Edn_util.keyword_t ("thread-api/" ^ name)
+
+module T = Transit_melange.Transit.Json
+module E = Melange_edn_melange
+
+let starts_with ~prefix value =
+  let prefix_len = String.length prefix in
+  String.length value >= prefix_len && String.sub value 0 prefix_len = prefix
+
+let strip_prefix prefix value =
+  if starts_with ~prefix value then
+    String.sub value (String.length prefix)
+      (String.length value - String.length prefix)
+  else value
+
+let transit_keyword_name keyword = strip_prefix ":" keyword
+let value_of_transit = T.to_edn
+let transit_json_of_value value = T.to_string (T.of_edn value)
+let value_of_transit_string text = T.of_string text |> value_of_transit
+let edn_of_value value = value
+let value_of_edn value = value
+
+let normalize_base_url base_url =
+  let base_url = String.trim base_url in
+  if base_url = "" then invalid_arg "base-url is required"
+  else if
+    String.length base_url > 0 && base_url.[String.length base_url - 1] = '/'
+  then String.sub base_url 0 (String.length base_url - 1)
+  else base_url
+
+let find_substring_from ~needle haystack start =
+  let needle_len = String.length needle in
+  let haystack_len = String.length haystack in
+  let rec matches needle_index haystack_index =
+    needle_index = needle_len
+    || haystack.[haystack_index] = needle.[needle_index]
+       && matches (needle_index + 1) (haystack_index + 1)
+  in
+  let rec loop idx =
+    match String.index_from_opt haystack idx needle.[0] with
+    | None -> None
+    | Some idx ->
+        if idx + needle_len > haystack_len then None
+        else if matches 0 idx then Some idx
+        else loop (idx + 1)
+  in
+  if needle_len = 0 then Some start else loop start
+
+let http_error_message status body =
+  let fallback =
+    if String.trim body = "" then
+      "http request failed (" ^ string_of_int status ^ ")"
+    else
+      "http request failed (" ^ string_of_int status ^ ")\nhttp response: "
+      ^ body
+  in
+  try
+    match Json_util.object_of_json_string body with
+    | Some object_ ->
+        Option.value
+          (match Json_util.nested_string_field object_ "error" "message" with
+          | Some _ as message -> message
+          | None -> Json_util.string_field object_ "message")
+          ~default:fallback
+    | None -> fallback
+  with _ -> fallback
+
+let response_status response = Fetch.Response.status response
+let success_status status = status >= 200 && status <= 299
+
+let request ?timeout_span method_ uri ~headers ~body =
+  Cli_platform.HTTP.request ?timeout_span method_ uri ~headers ~body
+  >>= fun (response, body) ->
+  let status = response_status response in
+  if success_status status then Cli_effect.pure (response, body)
+  else Cli_effect.error (Failure (http_error_message status body))
+
+let method_name method_ = Edn_util.keyword_to_string method_ |> String.trim
+
+let invoke_body method_ args =
+  let args_transit = transit_json_of_value (Edn_util.vector_vec args) in
+  Json_util.string_of_string_fields
+    (Vec.of_array
+       [| ("method", method_name method_); ("argsTransit", args_transit) |])
+
+let invoke config method_ args =
+  let base_url = normalize_base_url config.base_url in
+  let stage = "transport.invoke:" ^ method_name method_ in
+  Profile_types.time config.profile_session stage (fun () ->
+      Cli_effect.map
+        (fun (_response, body) ->
+          match Json_util.object_of_json_string body with
+          | Some object_ -> (
+              match Json_util.string_field object_ "resultTransit" with
+              | Some result_transit -> value_of_transit_string result_transit
+              | None -> Edn_util.nil)
+          | None -> Edn_util.nil)
+        (request ~timeout_span:config.timeout_span Fetch.Post
+           (base_url ^ "/v1/invoke")
+           ~headers:
+             (Vec.of_array
+                [|
+                  ("Content-Type", "application/json");
+                  ("Accept", "application/json");
+                |])
+           ~body:(invoke_body method_ args)))
+
+let repo_value repo = Edn_util.string (Cli_primitive.string_of_repo repo)
+
+let thread_api_apply_outliner_ops config ~(repo : Cli_primitive.repo)
+    ~(ops : Melange_edn_melange.vector Melange_edn_melange.t)
+    ~(options : Melange_edn_melange.map Melange_edn_melange.t) =
+  invoke config
+    (thread_api_method "apply-outliner-ops")
+    (Vec.of_array [| repo_value repo; Edn_util.any ops; Edn_util.any options |])
+
+let thread_api_backup_db_sqlite config ~(repo : Cli_primitive.repo) ~path =
+  invoke config
+    (thread_api_method "backup-db-sqlite")
+    (Vec.of_array [| repo_value repo; Edn_util.string path |])
+
+let thread_api_cli_list_nodes config ~(repo : Cli_primitive.repo)
+    ~(options : Melange_edn_melange.map Melange_edn_melange.t) =
+  invoke config
+    (thread_api_method "cli-list-nodes")
+    (Vec.of_array [| repo_value repo; Edn_util.any options |])
+
+let thread_api_cli_list_pages config ~(repo : Cli_primitive.repo)
+    ~(options : Melange_edn_melange.map Melange_edn_melange.t) =
+  invoke config
+    (thread_api_method "cli-list-pages")
+    (Vec.of_array [| repo_value repo; Edn_util.any options |])
+
+let thread_api_cli_list_properties config ~(repo : Cli_primitive.repo)
+    ~(options : Melange_edn_melange.map Melange_edn_melange.t) =
+  invoke config
+    (thread_api_method "cli-list-properties")
+    (Vec.of_array [| repo_value repo; Edn_util.any options |])
+
+let thread_api_cli_list_tags config ~(repo : Cli_primitive.repo)
+    ~(options : Melange_edn_melange.map Melange_edn_melange.t) =
+  invoke config
+    (thread_api_method "cli-list-tags")
+    (Vec.of_array [| repo_value repo; Edn_util.any options |])
+
+let thread_api_cli_list_tasks config ~(repo : Cli_primitive.repo)
+    ~(options : Melange_edn_melange.map Melange_edn_melange.t) =
+  invoke config
+    (thread_api_method "cli-list-tasks")
+    (Vec.of_array [| repo_value repo; Edn_util.any options |])
+
+let thread_api_create_or_open_db config ~(repo : Cli_primitive.repo)
+    ~(options : Melange_edn_melange.map Melange_edn_melange.t) =
+  invoke config
+    (thread_api_method "create-or-open-db")
+    (Vec.of_array [| repo_value repo; Edn_util.any options |])
+
+let thread_api_db_sync_download_graph_by_id config ~(repo : Cli_primitive.repo)
+    ~graph_id ~graph_e2ee =
+  invoke config
+    (thread_api_method "db-sync-download-graph-by-id")
+    (Vec.of_array
+       [| repo_value repo; Edn_util.string graph_id; Edn_util.bool graph_e2ee |])
+
+let thread_api_db_sync_ensure_user_rsa_keys ?options config =
+  let args =
+    match options with
+    | None -> Vec.empty
+    | Some options -> Vec.singleton (Edn_util.any options)
+  in
+  invoke config (thread_api_method "db-sync-ensure-user-rsa-keys") args
+
+let thread_api_db_sync_grant_graph_access config ~(repo : Cli_primitive.repo)
+    ~graph_id ~email =
+  invoke config
+    (thread_api_method "db-sync-grant-graph-access")
+    (Vec.of_array
+       [| repo_value repo; Edn_util.string graph_id; Edn_util.string email |])
+
+let thread_api_db_sync_list_remote_graphs config =
+  invoke config (thread_api_method "db-sync-list-remote-graphs") Vec.empty
+
+let thread_api_db_sync_request_asset_download config
+    ~(repo : Cli_primitive.repo) ~asset_uuid =
+  invoke config
+    (thread_api_method "db-sync-request-asset-download")
+    (Vec.of_array [| repo_value repo; Edn_util.uuid asset_uuid |])
+
+let thread_api_db_sync_start config ~(repo : Cli_primitive.repo) =
+  invoke config
+    (thread_api_method "db-sync-start")
+    (Vec.singleton (repo_value repo))
+
+let thread_api_db_sync_status config ~(repo : Cli_primitive.repo) =
+  invoke config
+    (thread_api_method "db-sync-status")
+    (Vec.singleton (repo_value repo))
+
+let thread_api_db_sync_stop config =
+  invoke config (thread_api_method "db-sync-stop") Vec.empty
+
+let thread_api_db_sync_upload_graph config ~(repo : Cli_primitive.repo) =
+  invoke config
+    (thread_api_method "db-sync-upload-graph")
+    (Vec.singleton (repo_value repo))
+
+let thread_api_export_edn config ~(repo : Cli_primitive.repo)
+    ~(options : Melange_edn_melange.map Melange_edn_melange.t) =
+  invoke config
+    (thread_api_method "export-edn")
+    (Vec.of_array [| repo_value repo; Edn_util.any options |])
+
+let thread_api_get_block_parents config ~(repo : Cli_primitive.repo) ~block_id =
+  invoke config
+    (thread_api_method "get-block-parents")
+    (Vec.of_array [| repo_value repo; Edn_util.int64 block_id |])
+
+let thread_api_get_block_refs config ~(repo : Cli_primitive.repo) ~block_id =
+  invoke config
+    (thread_api_method "get-block-refs")
+    (Vec.of_array [| repo_value repo; Edn_util.int64 block_id |])
+
+let thread_api_get_e2ee_password config ~refresh_token =
+  invoke config
+    (thread_api_method "get-e2ee-password")
+    (Vec.singleton (Edn_util.string refresh_token))
+
+let thread_api_import_db_binary config ~(repo : Cli_primitive.repo) ~data =
+  invoke config
+    (thread_api_method "import-db-binary")
+    (Vec.of_array [| repo_value repo; data |])
+
+let thread_api_import_edn config ~(repo : Cli_primitive.repo) ~data =
+  invoke config
+    (thread_api_method "import-edn")
+    (Vec.of_array [| repo_value repo; data |])
+
+let thread_api_pull config ~(repo : Cli_primitive.repo)
+    ~(selector : Melange_edn_melange.vector Melange_edn_melange.t) ~lookup =
+  invoke config (thread_api_method "pull")
+    (Vec.of_array [| repo_value repo; Edn_util.any selector; lookup |])
+
+let thread_api_q config ~(repo : Cli_primitive.repo)
+    ~(query : Melange_edn_melange.vector Melange_edn_melange.t) =
+  invoke config (thread_api_method "q")
+    (Vec.of_array [| repo_value repo; Edn_util.any query |])
+
+let thread_api_set_db_sync_config config ~config:sync_config =
+  invoke config
+    (thread_api_method "set-db-sync-config")
+    (Vec.singleton (Edn_util.any sync_config))
+
+let thread_api_sync_app_state config
+    ~(auth_state : Melange_edn_melange.map Melange_edn_melange.t) =
+  invoke config
+    (thread_api_method "sync-app-state")
+    (Vec.singleton (Edn_util.any auth_state))
+
+let thread_api_validate_db config ~(repo : Cli_primitive.repo)
+    ~(options : Melange_edn_melange.map Melange_edn_melange.t) =
+  invoke config
+    (thread_api_method "validate-db")
+    (Vec.of_array [| repo_value repo; Edn_util.any options |])
+
+let thread_api_verify_and_save_e2ee_password config ~refresh_token ~password =
+  invoke config
+    (thread_api_method "verify-and-save-e2ee-password")
+    (Vec.of_array [| Edn_util.string refresh_token; Edn_util.string password |])
+
+let value_get_string_key key value =
+  match Edn_util.as_map value with
+  | Some fields ->
+      Vec.find_map
+        (fun (field_key, value) ->
+          match
+            (Edn_util.as_string_like field_key, Edn_util.as_string value)
+          with
+          | Some field, Some value when field = key -> Some value
+          | _ -> None)
+        fields
+  | None -> None
+
+let keyword_from_string value = Edn_util.keyword_t (transit_keyword_name value)
+
+let decode_event_payload payload =
+  try value_of_transit_string payload with _ -> Edn_util.string payload
+
+let max_non_progress_event_decode_bytes = 256 * 1024
+
+let decode_event event_text =
+  let data_line =
+    Vec.split_on_char '\n' event_text
+    |> Vec.find_map (fun line ->
+        if starts_with ~prefix:"data: " line then
+          Some (String.sub line 6 (String.length line - 6))
+        else None)
+  in
+  match data_line with
+  | None -> None
+  | Some data -> (
+      try
+        let json = Js.Json.parseExn data in
+        let event_type =
+          Option.bind (Js.Json.decodeObject json) (fun object_ ->
+              Json_util.string_field object_ "type")
+        in
+        match event_type with
+        | Some event_type
+          when event_type <> "rtc-log"
+               && String.length data > max_non_progress_event_decode_bytes ->
+            Some (keyword_from_string event_type, Edn_util.nil)
+        | _ -> (
+            let event = Json_util.value_of_json json in
+            let decoded_payload =
+              match value_get_string_key "payload" event with
+              | Some payload -> decode_event_payload payload
+              | None -> Edn_util.nil
+            in
+            match Edn_util.as_vector decoded_payload with
+            | Some values when Vec.length values = 2 -> (
+                let event_type_value = Vec.nth values 0 in
+                let payload = Vec.nth values 1 in
+                match Edn_util.as_keyword_t event_type_value with
+                | Some event_type -> Some (event_type, payload)
+                | None -> None)
+            | _ -> (
+                match value_get_string_key "type" event with
+                | Some event_type ->
+                    Some (keyword_from_string event_type, decoded_payload)
+                | None -> None))
+      with _ -> None)
+
+let split_sse_events buffer =
+  let rec loop start acc =
+    match find_substring_from ~needle:"\n\n" buffer start with
+    | None ->
+        (acc, String.sub buffer start (String.length buffer - start))
+    | Some idx ->
+        let event_text = String.sub buffer start (idx - start) in
+        loop (idx + 2) (Vec.push_back acc event_text)
+  in
+  loop 0 Vec.empty
+
+let dispatch_event on_event event_type payload =
+  Cli_effect.async (fun () ->
+      Cli_effect.catch (on_event event_type payload) (fun _ ->
+          Cli_effect.pure ()))
+
+let consume_sse_chunk on_event buffer chunk =
+  let events, rest = split_sse_events (!buffer ^ chunk) in
+  buffer := rest;
+  Vec.iter
+    (fun event_text ->
+      match decode_event event_text with
+      | Some (event_type, payload) -> dispatch_event on_event event_type payload
+      | None -> ())
+    events
+
+let connect_events config on_event =
+  let base_url = normalize_base_url config.base_url in
+  let buffer = ref "" in
+  Cli_effect.map
+    (fun (subscription : Cli_platform.Events.subscription) ->
+      { close = subscription.close })
+    (Cli_platform.Events.connect ~url:(base_url ^ "/v1/events")
+       ~on_chunk:(consume_sse_chunk on_event buffer))
+
+let normalize_format format = Edn_util.keyword_to_string format |> String.trim
+
+let write_file_text path content =
+  Cli_unix.write_text_file path Ustring.(of_string content |> to_string)
+
+let read_file_text path = Cli_unix.read_text_file path
+let write_file_binary path content = Cli_unix.write_binary_file path content
+let read_file_binary path = Bytes.of_string (Cli_unix.read_binary_file path)
+
+let bytes_of_output_data value =
+  match (Edn_util.as_bytes value, Edn_util.as_string value) with
+  | Some bytes, _ -> Bytes.to_string bytes
+  | _, Some value -> value
+  | _ -> Melange_edn_melange.to_edn_string value
+
+let unsupported_output_format format =
+  Error.make Error.Unsupported_output_format
+    ("unsupported output format: " ^ format)
+
+let unsupported_input_format format =
+  Error.make Error.Unsupported_input_format
+    ("unsupported input format: " ^ format)
+
+let write_output ~format ~path ~data =
+  let format = normalize_format format in
+  try
+    let result =
+      match format with
+      | "edn" ->
+          write_file_text path (E.to_edn_string (edn_of_value data));
+          Ok ()
+      | "db" | "sqlite" ->
+          write_file_binary path (bytes_of_output_data data);
+          Ok ()
+      | _ -> Error (unsupported_output_format format)
+    in
+    Cli_effect.pure result
+  with exn -> Cli_effect.pure (Error (Error.exception_error exn))
+
+let read_input ~format ~path =
+  let format = normalize_format format in
+  try
+    let result =
+      match format with
+      | "edn" ->
+          let content = read_file_text path in
+          Ok (E.of_edn_string content |> value_of_edn)
+      | "db" | "sqlite" -> Ok (Edn_util.bytes (read_file_binary path))
+      | _ -> Error (unsupported_input_format format)
+    in
+    Cli_effect.pure result
+  with exn -> Cli_effect.pure (Error (Error.exception_error exn))

cli/lib/tree_text_types.ml

@@ -0,0 +1,6 @@
+type render_options = {
+  uuid_labels : (Cli_primitive.uuid * string) Rrbvec.t;
+  property_titles : (Cli_primitive.keyword * string) Rrbvec.t;
+  property_value_labels : (Melange_edn_melange.any * string) Rrbvec.t;
+  show_ids : bool;
+}

cli/lib/update.ml

@@ -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;
+    }

cli/lib/ustring.ml

@@ -0,0 +1,38 @@
+type t = string
+type uint8_array
+type text_decoder
+
+external char_code_at : string -> int -> int = "charCodeAt" [@@mel.send]
+external uint8_array_from : string -> (string -> int) -> uint8_array = "from"
+[@@mel.scope "Uint8Array"]
+
+external make_text_decoder : string -> < fatal : bool > Js.t -> text_decoder
+  = "TextDecoder"
+[@@mel.new]
+
+external decode : text_decoder -> uint8_array -> string = "decode" [@@mel.send]
+
+type string_kind = Ascii | Utf8_bytes | Unicode
+
+let decoder = make_text_decoder "utf-8" [%obj { fatal = true }]
+
+let string_kind value =
+  let length = String.length value in
+  let rec loop index =
+    if index >= length then Ascii
+    else
+      let code = char_code_at value index in
+      if code > 0xff then Unicode
+      else if code > 0x7f then Utf8_bytes
+      else loop (index + 1)
+  in
+  loop 0
+
+let of_string value =
+  match string_kind value with
+  | Ascii | Unicode -> value
+  | Utf8_bytes ->
+      let payload = uint8_array_from value (fun ch -> char_code_at ch 0) in
+      (try decode decoder payload with _ -> value)
+
+let to_string value = value

cli/lib/uuid_refs_types.ml

@@ -0,0 +1,198 @@
+type uuid_label = {
+  uuid : Cli_primitive.uuid;
+  id : Cli_primitive.db_id option;
+  label : string option;
+}
+
+let uuid_ref_max_depth = 10
+let lower_uuid uuid = String.lowercase_ascii uuid
+
+let unique_preserve_order values =
+  let rec loop seen acc values =
+    match Vec.pop_front values with
+    | None -> acc
+    | Some (value, rest) ->
+        if Vec.mem value seen then loop seen acc rest
+        else loop (Vec.push_front seen value) (Vec.push_back acc value) rest
+  in
+  loop Vec.empty Vec.empty values
+
+let find_substring_from ~needle haystack start =
+  let needle_len = String.length needle in
+  let haystack_len = String.length haystack in
+  let rec loop index =
+    if index + needle_len > haystack_len then None
+    else if String.sub haystack index needle_len = needle then Some index
+    else loop (index + 1)
+  in
+  loop start
+
+let extract_wiki_refs value =
+  let rec loop start acc =
+    match find_substring_from ~needle:"[[" value start with
+    | None -> unique_preserve_order acc
+    | Some open_index -> (
+        let content_start = open_index + 2 in
+        match find_substring_from ~needle:"]]" value content_start with
+        | None -> unique_preserve_order acc
+        | Some close_index ->
+            let candidate =
+              String.sub value content_start (close_index - content_start)
+            in
+            loop (close_index + 2) (Vec.push_back acc candidate))
+  in
+  loop 0 Vec.empty
+
+let extract_uuid_refs value =
+  value |> extract_wiki_refs
+  |> Vec.filter Cli_primitive.is_uuid_string
+  |> Vec.map lower_uuid |> unique_preserve_order
+
+let label_lookup labels uuid =
+  let uuid = lower_uuid uuid in
+  Vec.find_map
+    (fun (candidate, label) ->
+      if lower_uuid candidate = uuid then Some label else None)
+    labels
+
+let replace_uuid_refs_once value labels =
+  let buffer = Buffer.create (String.length value) in
+  let rec loop start changed =
+    match find_substring_from ~needle:"[[" value start with
+    | None ->
+        Buffer.add_substring buffer value start (String.length value - start);
+        (Buffer.contents buffer, changed)
+    | Some open_index -> (
+        Buffer.add_substring buffer value start (open_index - start);
+        let content_start = open_index + 2 in
+        match find_substring_from ~needle:"]]" value content_start with
+        | None ->
+            Buffer.add_substring buffer value open_index
+              (String.length value - open_index);
+            (Buffer.contents buffer, changed)
+        | Some close_index -> (
+            let candidate =
+              String.sub value content_start (close_index - content_start)
+            in
+            match label_lookup labels candidate with
+            | Some label when Cli_primitive.is_uuid_string candidate ->
+                Buffer.add_string buffer ("[[" ^ label ^ "]]");
+                loop (close_index + 2) true
+            | _ ->
+                Buffer.add_substring buffer value open_index
+                  (close_index + 2 - open_index);
+                loop (close_index + 2) changed))
+  in
+  loop 0 false
+
+let replace_uuid_refs text labels =
+  let rec loop remaining current =
+    if remaining <= 0 || Vec.is_empty labels then current
+    else
+      let next, changed = replace_uuid_refs_once current labels in
+      if changed then loop (remaining - 1) next else current
+  in
+  loop uuid_ref_max_depth text
+
+let collect_uuid_refs_from_strings values =
+  values |> Vec.concat_map extract_uuid_refs |> unique_preserve_order
+
+let field_text field = Edn_util.keyword_to_string field
+
+let string_field item field =
+  Edn_util.get_string item.Entity.raw (field_text field)
+
+let collect_uuid_refs_from_items items fields =
+  items
+  |> Vec.concat_map (fun item -> Vec.filter_map (string_field item) fields)
+  |> collect_uuid_refs_from_strings
+
+let normalize_entity_field item field labels =
+  match string_field item field with
+  | None -> item
+  | Some value ->
+      let value = replace_uuid_refs value labels in
+      let field = field_text field in
+      let raw = Edn_util.assoc field (Edn_util.string value) item.Entity.raw in
+      let item = { item with Entity.raw } in
+      if field = "block/title" then { item with title = Some value }
+      else if field = "block/name" || field = "name" then
+        { item with name = Some value }
+      else item
+
+let normalize_item_string_fields items fields labels =
+  Vec.map
+    (fun item ->
+      Vec.fold_left
+        (fun item field -> normalize_entity_field item field labels)
+        item fields)
+    items
+
+let kw value = Edn_util.keyword value
+let vector_vec values = Edn_util.vector_vec values
+
+let uuid_lookup_selector =
+  vector_vec
+    (Vec.of_array
+       [| kw "db/id"; kw "block/uuid"; kw "block/title"; kw "block/name" |])
+
+let uuid_lookup uuid =
+  vector_vec (Vec.of_array [| kw "block/uuid"; Edn_util.uuid uuid |])
+
+let value_uuid value =
+  match
+    Option.bind (Edn_util.get value "block/uuid") Edn_util.as_string_like
+  with
+  | Some uuid when Cli_primitive.is_uuid_string uuid -> Some (lower_uuid uuid)
+  | _ -> None
+
+let label_of_value value =
+  match Edn_util.get_string value "block/title" with
+  | Some title when String.trim title <> "" -> Some title
+  | _ -> (
+      match Edn_util.get_string value "block/name" with
+      | Some name when String.trim name <> "" -> Some name
+      | _ -> value_uuid value)
+
+let fetch_uuid_entities config repo uuids =
+  let uuids =
+    uuids
+    |> Vec.filter Cli_primitive.is_uuid_string
+    |> Vec.map lower_uuid |> unique_preserve_order
+  in
+  let open Cli_effect in
+  bind (Server_runtime.ensure_server config repo ~create_empty_db:false)
+    (function
+    | Error _ -> pure Vec.empty
+    | Ok invoke_config ->
+        let rec pull acc uuids =
+          match Vec.pop_front uuids with
+          | None -> pure acc
+          | Some (uuid, rest) ->
+              bind
+                (Transport.thread_api_pull invoke_config ~repo
+                   ~selector:
+                     (Edn_util.expect_vector_t "uuid lookup selector"
+                        uuid_lookup_selector)
+                   ~lookup:(uuid_lookup uuid))
+                (fun value ->
+                  let acc =
+                    match value_uuid value with
+                    | None -> acc
+                    | Some uuid ->
+                        Vec.push_back acc
+                          {
+                            uuid;
+                            id = Edn_util.get_int64 value "db/id";
+                            label = label_of_value value;
+                          }
+                  in
+                  pull acc rest)
+        in
+        pull Vec.empty uuids)
+
+let fetch_uuid_labels config repo uuids =
+  Cli_effect.map
+    (Vec.filter_map (fun entry ->
+         Option.map (fun label -> (entry.uuid, label)) entry.label))
+    (fetch_uuid_entities config repo uuids)

cli/lib/vec.ml

@@ -0,0 +1,14 @@
+include Rrbvec
+
+let string_concat sep values = String.concat sep (to_list values)
+
+let split_on_char sep value =
+  let len = String.length value in
+  let rec loop start index acc =
+    if index = len then push_back acc (String.sub value start (index - start))
+    else if value.[index] = sep then
+      let acc = push_back acc (String.sub value start (index - start)) in
+      loop (index + 1) (index + 1) acc
+    else loop start (index + 1) acc
+  in
+  loop 0 0 empty