Kento Okura: 1 LSP command for creating new trees 7 files changed, 155 insertions(+), 167 deletions(-)
Copy & paste the following snippet into your terminal to import this patchset into git:
curl -s https://lists.sr.ht/~jonsterling/forester-devel/patches/55992/mbox | git am -3Learn more about email & git
This includes some changes to code outside of the lsp module:
I forgot to mention: I will apply this myself on the lsp-refactor branch, I sent it for code review
- The "--dest" option is removed. Instead, forester will use the directory that contains the latest tree of the specified prefix. In random mode, it will put the tree in some directory that also contains a tree of the prefix. The reason for this change is that there is no way to specify a destination directory from using the code action interface (at least I don't know how this would be done) - The config parser now parses a key "prefixes". This is necessary to create the code actions. --- bin/forester/main.ml | 23 ++-- lib/frontend/Config.ml | 8 +- lib/frontend/Config.mli | 1 + lib/frontend/Forester.ml | 52 ++------- lib/frontend/Forester.mli | 8 +- lib/frontend/Iri_util.ml | 61 +++++++++++ lib/language_server/Code_action.ml | 169 +++++++++++------------------ 7 files changed, 155 insertions(+), 167 deletions(-) create mode 100644 lib/frontend/Iri_util.ml diff --git a/bin/forester/main.ml b/bin/forester/main.ml index ace8079..649f59b 100644 --- a/bin/forester/main.ml @@ -38,7 +38,7 @@ let build ~env config_filename dev no_theme = let@ dir_to_copy = List.iter @~ dirs_to_copy in Forester.copy_contents_of_dir ~env @@ path_of_dir ~env dir_to_copy -let new_tree ~env config_filename dest_dir prefix template random = +let new_tree ~env config_filename prefix template random = let@ () = Reporter.silence in let config = Forester_frontend.Config.parse_forest_config_file config_filename in let tree_dirs = paths_of_dirs ~env config.trees in @@ -46,9 +46,10 @@ let new_tree ~env config_filename dest_dir prefix template random = let foreign_paths = paths_of_dirs ~env config.foreign in Forester.plant_raw_forest_from_dirs ~env ~host: config.host ~dev: true ~tree_dirs ~asset_dirs ~foreign_paths; let mode = if random then `Random else `Sequential in - let dest = path_of_dir ~env dest_dir in - let addr = Forester.create_tree ~env ~dest ~prefix ~template ~mode in - Format.printf "%s/%s.tree\n" dest_dir addr + (* let dest = path_of_dir ~env dest_dir in *) + let _ = Forester.create_tree ~env ~prefix ~template ~mode ~config in + () +(* Format.printf "%s/%s.tree\n" dest_dir addr *) let complete ~env config_filename title = let@ () = Reporter.silence in @@ -184,12 +185,12 @@ let new_tree_cmd ~env = Arg.opt (Arg.some Arg.string) None @@ Arg.info ["template"] ~docv: "XXX" ~doc in - let arg_dest_dir = - let doc = "The directory in which to deposit created tree." in - Arg.required @@ - Arg.opt (Arg.some Arg.dir) None @@ - Arg.info ["dest"] ~docv: "DEST" ~doc - in + (* let arg_dest_dir = *) + (* let doc = "The directory in which to deposit created tree." in *) + (* Arg.required @@ *) + (* Arg.opt (Arg.some Arg.dir) None @@ *) + (* Arg.info ["dest"] ~docv: "DEST" ~doc *) + (* in *) let arg_random = let doc = "True if the new tree should have id assigned randomly rather than sequentially" in Arg.value @@ Arg.flag @@ Arg.info ["random"] ~doc @@ -201,7 +202,7 @@ let new_tree_cmd ~env = Term.( const (new_tree ~env) $ arg_config - $ arg_dest_dir + (* $ arg_dest_dir *) $ arg_prefix $ arg_template $ arg_random diff --git a/lib/frontend/Config.ml b/lib/frontend/Config.ml index c6c3f33..0c3efad 100644 --- a/lib/frontend/Config.ml +++ b/lib/frontend/Config.ml @@ -15,6 +15,7 @@ module Forest_config = struct assets: string list; foreign: string list; theme: string; + prefixes: string list; } [@@deriving show, repr] end @@ -27,6 +28,7 @@ let default_forest_config : Forest_config.t = foreign = []; theme = "theme"; home = None; + prefixes = []; } let parse_forest_config_file filename = @@ -75,4 +77,8 @@ let parse_forest_config_file filename = Option.value ~default: default_forest_config.theme @@ get tbl (forest |-- key "theme" |-- string) in - Forest_config.{ host; assets; trees; foreign; theme; home } + let prefixes = + Option.value ~default: default_forest_config.prefixes @@ + get tbl (forest |-- key "prefixes" |-- array |-- strings) + in + Forest_config.{ host; assets; trees; foreign; theme; home; prefixes } diff --git a/lib/frontend/Config.mli b/lib/frontend/Config.mli index d420fdd..84ffcf7 100644 --- a/lib/frontend/Config.mli +++ b/lib/frontend/Config.mli @@ -12,6 +12,7 @@ module Forest_config: sig assets: string list; foreign: string list; theme: string; + prefixes: string list; } [@@deriving show] end diff --git a/lib/frontend/Forester.ml b/lib/frontend/Forester.ml index 709667c..d6f1dae 100644 --- a/lib/frontend/Forester.ml +++ b/lib/frontend/Forester.ml @@ -20,56 +20,22 @@ module EP = Eio.Path type env = Eio_unix.Stdenv.base type dir = Eio.Fs.dir_ty EP.t -let output_dir_name = "output" - -let rec random_not_in keys = - let attempt = Random.int (36 * 36 * 36 * 36 - 1) in - if List.fold_left (fun x y -> x || y) false (List.map (fun k -> k = attempt) keys) then - random_not_in keys - else - attempt - -let split_addr addr = - (* primitively check for address of form YYYY-MM-DD *) - let date_regex = Str.regexp {|^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]$|} in - if Str.string_match date_regex addr 0 then - (addr, None) - else - match String.rindex_opt addr '-' with - | Some i -> - let prefix = String.sub addr 0 i - and suffix = String.sub addr (i + 1) (String.length addr - i - 1) - in - begin - match BaseN.Base36.int_of_string suffix with - | Some key -> prefix, Some key - | None -> addr, None - end - | _ -> addr, None +let (let*) = Option.bind -let next_addr ~prefix ~mode (addrs : string list) = - let keys = - let@ addr = List.filter_map @~ addrs in - let prefix', key = split_addr addr in - if prefix = prefix' then key else None - in - let next = - match mode with - | `Sequential -> 1 + List.fold_left max 0 keys - | `Random -> random_not_in keys - in - prefix ^ "-" ^ BaseN.Base36.string_of_int next +let output_dir_name = "output" -let create_tree ~env ~dest ~prefix ~template ~mode = +let create_tree ~env ~prefix ~template ~mode ~config = let addrs = let@ article = List.filter_map @~ FU.get_all_articles () in let@ iri = Option.bind article.frontmatter.iri in let (Absolute path | Relative path) = Iri.path iri in match List.rev path with - | name :: _ -> Some name + | name :: _ -> + let* path = article.frontmatter.source_path in + Some (name, path) | _ -> None in - let next = next_addr addrs ~prefix ~mode in + let next, next_dir = Iri_util.next_addr addrs ~prefix ~mode ~config in let fname = next ^ ".tree" in let now = Human_datetime.now () in let template_content = @@ -79,9 +45,9 @@ let create_tree ~env ~dest ~prefix ~template ~mode = in let body = Format.asprintf "\\date{%a}\n" Human_datetime.pp now in let create = `Exclusive 0o644 in - let path = EP.(dest / fname) in + let path = EP.(env#fs / next_dir / fname) in EP.save ~create path @@ body ^ template_content; - next + EP.native_exn path let complete ~host prefix = let@ article = Seq.filter_map @~ List.to_seq @@ FU.get_all_articles () in diff --git a/lib/frontend/Forester.mli b/lib/frontend/Forester.mli index fd9d97c..d2b03b8 100644 --- a/lib/frontend/Forester.mli +++ b/lib/frontend/Forester.mli @@ -36,18 +36,12 @@ val copy_contents_of_dir : dir -> unit -val next_addr : - prefix:string -> - mode:[< `Random | `Sequential ] -> - string list -> - string - val create_tree : env: env -> - dest: dir -> prefix: string -> template: string option -> mode: [`Sequential | `Random] -> + config: Config.Forest_config.t -> string val json_manifest : diff --git a/lib/frontend/Iri_util.ml b/lib/frontend/Iri_util.ml new file mode 100644 index 0000000..9c11806 --- /dev/null +++ b/lib/frontend/Iri_util.ml @@ -0,0 +1,61 @@ +(* + * SPDX-FileCopyrightText: 2024 The Forester Project Contributors + * + * SPDX-License-Identifier: GPL-3.0-or-later + *) + +open Forester_prelude + +let rec random_not_in keys = + let attempt = Random.int (36 * 36 * 36 * 36 - 1) in + if List.fold_left (fun x y -> x || y) false (List.map (fun k -> k = attempt) keys) then + random_not_in keys + else + attempt + +let split_addr addr = + (* primitively check for address of form YYYY-MM-DD *) + let date_regex = Str.regexp {|^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]$|} in + if Str.string_match date_regex addr 0 then + (addr, None) + else + match String.rindex_opt addr '-' with + | Some i -> + let prefix = String.sub addr 0 i + and suffix = String.sub addr (i + 1) (String.length addr - i - 1) + in + begin + match BaseN.Base36.int_of_string suffix with + | Some key -> prefix, Some key + | None -> addr, None + end + | _ -> addr, None + +let next_addr + ~prefix + ~mode + ~(config : Config.Forest_config.t) + (addrs : (string * string) List.t) + = + let keys = + let@ (addr, uri) = List.filter_map @~ addrs in + let prefix', key = split_addr addr in + if prefix = prefix' then + Option.map (fun key -> (key, uri)) key + else None + in + let next, dest_dir = + match mode with + | `Sequential -> + let max, uri = + List.fold_left + (fun (i, uri) (acc_i, _) -> (max i acc_i, uri)) + (0, List.hd config.trees) + keys + in + 1 + max, uri + | `Random -> + random_not_in (List.map fst keys), + snd @@ List.hd keys + in + prefix ^ "-" ^ BaseN.Base36.string_of_int next, dest_dir diff --git a/lib/language_server/Code_action.ml b/lib/language_server/Code_action.ml index 9cd3671..28cc06f 100644 --- a/lib/language_server/Code_action.ml +++ b/lib/language_server/Code_action.ml @@ -5,133 +5,92 @@ * *) -open Forester_prelude +open Lsp_error module State = Analysis.State module L = Lsp.Types -let rec random_not_in keys = - let attempt = Random.int (36 * 36 * 36 * 36 - 1) in - if List.fold_left (fun x y -> x || y) false (List.map (fun k -> k = attempt) keys) then - random_not_in keys - else - attempt - -(*HACK: copied from Forester.ml. Find a good place for it.*) -let split_addr addr = - (* primitively check for address of form YYYY-MM-DD *) - let date_regex = Str.regexp {|^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]$|} in - if Str.string_match date_regex addr 0 then - (addr, None) - else - match String.rindex_opt addr '-' with - | Some i -> - let prefix = String.sub addr 0 i - and suffix = String.sub addr (i + 1) (String.length addr - i - 1) +(* This function is mainly decodes the arguments to the command*) +let execute (params : L.ExecuteCommandParams.t) = + let server = State.get () in + let config = server.config in + match params with + | { arguments; command; _ } -> + match command with + | "new tree" -> + let open Yojson.Safe.Util in + let prefix, mode = + match arguments with + | Some [json_stuff] -> + let prefix = json_stuff |> member "prefix" |> to_string in + let mode = + json_stuff |> member "mode" |> to_string + |> function + | "random" -> `Random + | "sequential" -> `Sequential + | _ -> + raise @@ + decode_error @@ + Format.asprintf + "got invalid arguments when executing \"new tree\" command" + in + prefix, mode + | x -> + raise @@ + decode_error @@ + Format.( + asprintf + "got invalid arguments when executing \"new tree\" command. Expected data in the shape of [{\"prefix\" = ..., \"mode\" = ...}], but got: %a." + (pp_print_option (pp_print_list Yojson.Safe.pp)) + x + ) in - begin - match Forester_prelude.BaseN.Base36.int_of_string suffix with - | Some key -> prefix, Some key - | None -> addr, None - end - | _ -> addr, None + let env = server.env in + let template = None in + let res = Forester_frontend.Forester.create_tree ~env ~prefix ~template ~mode ~config in + `String res + | _ -> `Null -let next_addr ~prefix ~mode (addrs : (string * Lsp.Uri.t) List.t) = - let keys = - let@ (addr, uri) = List.filter_map @~ addrs in - let prefix', key = split_addr addr in - if prefix = prefix' then Option.map (fun key -> (key, uri)) key else None - in - let next, uri = - match mode with - | `Sequential -> - let max, uri = - List.fold_left - (fun (i, uri) (acc_i, _) -> (max i acc_i, uri)) - (0, Lsp.Uri.of_path "") - keys - in - 1 + max, uri - | `Random -> - random_not_in (List.map fst keys), - snd @@ List.find (Fun.const true) keys - in - let dest_dir = - Lsp.Uri.to_path uri - |> String.split_on_char '/' - |> List.rev - |> List.tl - |> List.rev - |> String.concat "/" - in - prefix ^ "-" ^ BaseN.Base36.string_of_int next, dest_dir +let resolve (params : L.CodeAction.t) = params -let resolve (params : L.CodeAction.t) = - let server = State.get () in - match params.kind with - | Some (Other "new tree") -> - let mode = `Sequential in - let prefix = - match params.data with - | Some (`Assoc ["prefix", `String pfx]) -> pfx - | _ -> "" - in - let addr, dest_dir = - server.parsed - |> Analysis.to_table - |> Hashtbl.to_seq_keys - |> Seq.filter_map - ( - fun uri -> - let Iri.(Absolute path | Relative path) = - uri - |> Util.uri_to_iri ~host: server.config.host - |> Iri.path - in - match List.rev path with - | name :: _ -> - Some (name, uri) - | _ -> None - ) - |> List.of_seq - |> next_addr ~prefix ~mode - in - let edit = - let uri = Format.asprintf "%s/%s.tree" dest_dir addr |> Lsp.Uri.of_path in - Some - ( - L.WorkspaceEdit.create - ~documentChanges: [`CreateFile (L.CreateFile.create ~uri ())] - () - ) - in - { params with edit } - | _ -> params +let create_new_tree_cmd ~prefix ~mode = + let mode = match mode with `Sequential -> "sequential" | `Random -> "random" in + L.Command.create + ~command: "new tree" + ~title: "" + ~arguments: [ + `Assoc + [ + "prefix", `String prefix; + "mode", `String mode + ] + ] + () let compute (_params : L.CodeActionParams.t) : L.CodeActionResult.t = - let prefixes = ["foo"] in + let server = State.get () in + let prefixes = server.config.prefixes in + Eio.traceln "got %i prefixes" (List.length prefixes); let actions = - List.concat_map + prefixes + |> List.concat_map ( - fun pfx -> + fun prefix -> let sequential = L.CodeAction.create - ~title: (Format.asprintf "create tree with prefix %s" pfx) + ~title: (Format.asprintf "create tree with prefix %s" prefix) ~kind: (L.CodeActionKind.Other "new tree") - ~command: (L.Command.create ~command: "" ~title: "" ()) - ~data: (`Assoc ["prefix", `String pfx]) + ~command: (create_new_tree_cmd ~prefix ~mode: `Sequential) () in let random = L.CodeAction.create - ~title: (Format.asprintf "create tree with prefix %s (random)" pfx) + ~title: (Format.asprintf "create tree with prefix %s (random)" prefix) ~kind: (L.CodeActionKind.Other "new tree") - ~command: (L.Command.create ~command: "" ~title: "" ()) - ~data: (`Assoc ["prefix", `String pfx]) + ~command: (create_new_tree_cmd ~prefix ~mode: `Random) () in [`CodeAction sequential; `CodeAction random] ) - prefixes in Some actions -- 2.47.0