Something went wrong. Try again.
ocaml
Something went wrong. Try again.
6.4 kB · 205 lines
OCaml
at pp-ast
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206(* * SPDX-FileCopyrightText: 2024 The Forester Project Contributors AND The RedPRL Development Team * SPDX-FileCopyrightText: 2026 The Forester Project Contributors * * SPDX-License-Identifier: GPL-3.0-or-later * SPDX-License-Identifier: GPL-3.0-or-later OR Apache-2.0 WITH LLVM-exception *)
open Forester_coreopen Forester_compiler
open struct module L = Lsp.Typesend
let show_preview_url_command = "show preview URL"
let show_preview_url_action ~(forest : Forest.t) = match forest.port with | None -> [] | Some _ -> let command = L.Command.create ~command:show_preview_url_command ~title:"show live preview URL" () in [ `CodeAction (L.CodeAction.create ~title:"Show live preview URL" ~kind:(L.CodeActionKind.Other "show preview url") ~command ()); ]
let switch_configuration_command = "switch configuration"
let other_config_files ~(forest : Forest.t) = match forest.config.path with | None -> [] | Some current_path -> let dir = Filename.dirname current_path in let current_name = Filename.basename current_path in let names = try Eio.Path.read_dir Eio.Path.(Eio.Stdenv.fs forest.env / dir) |> List.filter (fun name -> let is_toml = Filename.extension name = ".toml" && name <> current_name in let is_valid = try Result.is_ok @@ Config_parser.parse_forest_config_file ~env:forest.env (Filename.concat dir name) with _ -> false in is_toml && is_valid) |> List.sort String.compare with _ -> [] in List.map (Filename.concat dir) names
let switch_configuration_action path = let title = Format.asprintf "Switch configuration to %s" (Filename.basename path) in let command = L.Command.create ~command:switch_configuration_command ~arguments:[`String path] ~title () in `CodeAction (L.CodeAction.create ~title ~kind:(L.CodeActionKind.Other "switch configuration") ~command ())
let switch_configuration_actions ~(forest : Forest.t) = List.map switch_configuration_action (other_config_files ~forest)
let execute (params : L.ExecuteCommandParams.t) : Yojson.Safe.t = if String.equal params.command show_preview_url_command then begin let Lsp_state.{forest; _} = Lsp_state.get () in let message = match forest.port with | Some port -> Format.asprintf "Forester live preview running on http://localhost:%d" port | None -> "Forester live preview is not currently running." in Publish.broadcast (ShowMessage (L.ShowMessageParams.create ~message ~type_:Info)); `Null end else if String.equal params.command switch_configuration_command then begin match params.arguments with | Some [`String path] -> Lsp_state.modify (fun ({forest; _} as lsp_state) -> Change_configuration.switch_to ~forest path; lsp_state); let message = Format.asprintf "Switched configuration to %s" (Filename.basename path) in Publish.broadcast (ShowMessage (L.ShowMessageParams.create ~message ~type_:Info)); `Null | _ -> Eio.traceln "invalid arguments for switch configuration"; `Null end else `Null
let tree_dir ~(forest : Forest.t) = match forest.config.trees with | [] -> None | dir :: _ -> Some begin match Eio_util.path_of_dir ~env:forest.env dir with | Ok path -> Eio.Path.native_exn path | Error _ -> dir end
let string_of_mode = function | `Sequential -> "sequential" | `Random -> "random"
let mode_of_string = function | "sequential" -> Some `Sequential | "random" -> Some `Random | _ -> None
let new_tree_data ~(uri : Lsp.Uri.t) ~range mode : Yojson.Safe.t = `Assoc [ ("uri", `String (Lsp.Uri.to_string uri)); ("range", L.Range.yojson_of_t range); ("mode", `String (string_of_mode mode)); ]
let new_tree_request (data : Yojson.Safe.t) = match data with | `Assoc fields -> begin let field name = List.assoc_opt name fields in match (field "uri", field "range", field "mode") with | Some (`String uri), Some range, Some (`String mode) -> begin match L.Range.t_of_yojson range with | exception Ppx_yojson_conv_lib.Yojson_conv.Of_yojson_error (_, _) -> None | range -> let@ mode = Option.map @~ mode_of_string mode in (Lsp.Uri.of_string uri, range, mode) end | _ -> None end | _ -> None
let create_tree_edit ~range ~uri addr dir = L.WorkspaceEdit.create ~documentChanges: [ `CreateFile (L.CreateFile.create ~uri:(Lsp.Uri.of_path (Format.asprintf "%s/%s.tree" dir addr)) ()); `TextDocumentEdit (L.TextDocumentEdit.create ~textDocument:{uri; version = None} ~edits: [ `TextEdit {newText = Format.asprintf "\\transclude{%s}" addr; range}; ]); ] ()
let compute L.CodeActionParams.{range; textDocument = {uri}; _} : L.CodeActionResult.t = let Lsp_state.{forest; _} = Lsp_state.get () in let actions = match forest.config.trees with | [] -> [] | _ :: _ -> let new_tree mode = `CodeAction (L.CodeAction.create ~title: (Format.asprintf "create new tree (%s address)" (string_of_mode mode)) ~kind:(L.CodeActionKind.Other "new tree") ~data:(new_tree_data ~uri ~range mode) ()) in [new_tree `Sequential; new_tree `Random] in Some (actions @ show_preview_url_action ~forest @ switch_configuration_actions ~forest)
let resolve (params : L.CodeAction.t) = let Lsp_state.{forest; _} = Lsp_state.get () in let action = let@ data = Option.bind params.data in let@ uri, range, mode = Option.bind (new_tree_request data) in let@ dir = Option.map @~ tree_dir ~forest in let addr = URI_util.next_uri ~prefix:None ~mode ~forest in {params with edit = Some (create_tree_edit ~range ~uri addr dir)} in if Option.is_some params.data && Option.is_none action then Logs.debug ~src:Log.Src.lsp (fun m -> m "could not resolve code action %S" params.title); Option.value action ~default:params