This includes some changes to code outside of the lsp module:
- 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
On Mon Nov 18, 2024 at 6:46 PM CET, Kento Okura wrote:
> 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
> +++ b/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