Initial import of LogDarioSeq baseline
Establishes version control for the personal Logseq DB fork before starting the server-client architecture migration and domain features described in docs/agent-guide and the approved implementation plan. Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
This commit is contained in:
270
cli/lib/doctor.ml
Normal file
270
cli/lib/doctor.ml
Normal file
@@ -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
|
||||
Reference in New Issue
Block a user