diff --git a/dune-project b/dune-project index bd67fdafb..0966ce86f 100644 --- a/dune-project +++ b/dune-project @@ -35,7 +35,7 @@ (core_kernel (>= v0.14.0)) (promise_jsoo - (>= 0.2.0)) + (>= 0.3.0)) (jsonoo (>= 0.2.0)))) @@ -50,6 +50,6 @@ (gen_js_api (>= 1.0.6)) (promise_jsoo - (>= 0.2.0)) + (>= 0.3.0)) (jsonoo (>= 0.2.0)))) diff --git a/src/cmd.ml b/src/cmd.ml index 61300dc16..9d86fa7e4 100644 --- a/src/cmd.ml +++ b/src/cmd.ml @@ -61,7 +61,9 @@ let check t = let+ s = check_spawn spawn in Spawn s -let run ?cwd ?stdin = function +let run ?cwd ?stdin = + let cwd = Option.map cwd ~f:Path.to_string in + function | Spawn { bin; args } -> ChildProcess.spawn (Path.to_string bin) (Array.of_list args) ?stdin (ChildProcess.Options.create ?cwd ()) @@ -92,9 +94,9 @@ let log ?(result : ChildProcess.return option) (t : t) = in log_json "external command" message -let output ?stdin (t : t) = +let output ?cwd ?stdin (t : t) = let open Promise.Syntax in - let+ (result : ChildProcess.return) = run ?stdin t in + let+ (result : ChildProcess.return) = run ?stdin ?cwd t in log ~result t; if result.exitCode = 0 then Ok result.stdout diff --git a/src/cmd.mli b/src/cmd.mli index 423423beb..2cc70e712 100644 --- a/src/cmd.mli +++ b/src/cmd.mli @@ -25,6 +25,7 @@ val check : t -> t Or_error.t Promise.t val log : ?result:ChildProcess.return -> t -> unit -val output : ?stdin:string -> t -> (stdout, stderr) result Promise.t +val output : + ?cwd:Path.t -> ?stdin:string -> t -> (stdout, stderr) result Promise.t val equal_spawn : spawn -> spawn -> bool diff --git a/src/esy.ml b/src/esy.ml index d34d5ddcf..2cc63f0c1 100644 --- a/src/esy.ml +++ b/src/esy.ml @@ -92,6 +92,15 @@ module State = struct | Pending end +let find_manifest_in_dir dir = + let open Promise.Syntax in + let esy_file = Path.(dir / "esy.json") in + let package_file = Path.(dir / "package.json") in + [ esy_file; package_file ] + |> Promise.List.find_map (fun path -> + let+ file_exists = path |> Path.to_string |> Fs.exists in + Option.some_if file_exists path) + let state t ~manifest = let root_str = Path.to_string manifest in let command = Cmd.append t [ "status"; "-P"; root_str ] in diff --git a/src/esy.mli b/src/esy.mli index c15780ef7..9aab77a08 100644 --- a/src/esy.mli +++ b/src/esy.mli @@ -11,6 +11,8 @@ type discover = val discover : dir:Path.t -> discover list Promise.t +val find_manifest_in_dir : Path.t -> Path.t option Promise.t + val exec : t -> manifest:Path.t -> args:string list -> Cmd.t val setup_toolchain : t -> manifest:Path.t -> unit Or_error.t Promise.t diff --git a/src/opam.ml b/src/opam.ml index f18533b6d..a183491d1 100644 --- a/src/opam.ml +++ b/src/opam.ml @@ -5,11 +5,13 @@ module Switch = struct | Local of Path.t (** if switch name is directory name where it's stored *) | Named of string (** if switch is stored in ~/.opam *) - let make switch_name = - if Char.equal switch_name.[0] '/' then - Local (Path.of_string switch_name) - else - Named switch_name + let of_string = function + | "" -> None + | switch_name -> + if Char.equal switch_name.[0] '/' then + Some (Local (Path.of_string switch_name)) + else + Some (Named switch_name) let name = function | Named s -> s @@ -35,12 +37,7 @@ let make () = let parse_switch_list out = let lines = String.split_on_chars ~on:[ '\n' ] out in - let result = - lines - |> List.filter_map ~f:(function - | "" -> None - | s -> Some (Switch.make s)) - in + let result = lines |> List.filter_map ~f:Switch.of_string in log "%d switches" (List.length result); result @@ -54,6 +51,16 @@ let switch_list t = [] | Ok out -> parse_switch_list out +let switch_show ?cwd t = + let command = Cmd.append t [ "switch"; "show" ] in + let open Promise.Syntax in + let+ output = Cmd.output ?cwd (Spawn command) in + match output with + | Ok out -> Switch.of_string out + | Error _ -> + show_message `Warn "Unable to read the current switch."; + None + let switch_arg switch = "--switch=" ^ Switch.name switch let exec t ~switch ~args = diff --git a/src/opam.mli b/src/opam.mli index dd584819d..a562e285b 100644 --- a/src/opam.mli +++ b/src/opam.mli @@ -3,7 +3,7 @@ module Switch : sig | Local of Path.t | Named of string - val make : string -> t + val of_string : string -> t option val name : t -> string @@ -16,6 +16,8 @@ val make : unit -> t option Promise.t val switch_list : t -> Switch.t list Promise.t +val switch_show : ?cwd:Path.t -> t -> Switch.t option Promise.t + val exec : t -> switch:Switch.t -> args:string list -> Cmd.t val exists : t -> switch:Switch.t -> bool Promise.t diff --git a/src/toolchain.ml b/src/toolchain.ml index 5fc9c2525..971340ed4 100644 --- a/src/toolchain.ml +++ b/src/toolchain.ml @@ -114,10 +114,12 @@ module Setting = struct in Esy manifest | Opam -> - let switch = - field "switch" (fun js -> Opam.Switch.make (decode_vars js)) json - in - Opam switch + field "switch" + (fun js -> + match Opam.Switch.of_string (decode_vars js) with + | Some switch -> Opam switch + | None -> Global) + json | Custom -> let template = field "template" decode_vars json in Custom template @@ -184,6 +186,65 @@ let of_settings () : t option Promise.t = | Some Global -> Promise.return (Some Global) | Some (Custom template) -> Promise.return (Some (Custom template)) +let detect_esy_sandbox ~project_root esy () = + let open Promise.Option.Syntax in + let* esy = esy in + let open Promise.Syntax in + let+ esy_build_dir_exists, manifest = + Promise.all2 + ( Fs.exists Path.(project_root / "_esy" |> Path.to_string) + , Esy.find_manifest_in_dir project_root ) + in + match (esy_build_dir_exists, manifest) with + | true, _ + | _, Some _ -> + (* Esy can be used with [esy.json], [package.json], or without any of those. + So we check if we find an [_esy] directory, which means the user created an Esy sandbox. + + If we don't, but there is an [esy.json] file, we can assume the user wants to use Esy. + *) + Some (Esy (esy, project_root)) + | false, None -> None + +let detect_opam_local_switch ~project_root opam () = + let open Promise.Option.Syntax in + let* opam = opam in + let* switch = Opam.switch_show ~cwd:project_root opam in + match switch with + | Local _ as switch -> Promise.Option.return (Opam (opam, switch)) + | Named _ -> Promise.return None + +let detect_opam_sandbox ~project_root opam () = + let open Promise.Option.Syntax in + let* opam = opam in + let+ switch = Opam.switch_show ~cwd:project_root opam in + Opam (opam, switch) + +let detect () = + match Workspace.workspaceFolders () with + | [] -> Promise.return None + | [ workspace_folder ] -> + let project_root = + workspace_folder |> WorkspaceFolder.uri |> Uri.path |> Path.of_string + in + let available = available_toolchains () in + Promise.List.find_map + (fun f -> f ()) + [ detect_opam_local_switch ~project_root available.opam + ; detect_esy_sandbox ~project_root available.esy + ; detect_opam_sandbox ~project_root available.opam + ] + | _ -> + (* If there are several workspace folders, skip the detection entirely. *) + Promise.return None + +let of_settings_or_detect () = + let open Promise.Syntax in + let* package_manager_opt = of_settings () in + match package_manager_opt with + | Some package_manager -> Promise.return (Some package_manager) + | None -> detect () + let save_to_settings toolchain = let to_setting = function | Esy (_, root) -> Setting.Esy root diff --git a/src/toolchain.mli b/src/toolchain.mli index a095c0633..ec41b1cad 100644 --- a/src/toolchain.mli +++ b/src/toolchain.mli @@ -30,6 +30,10 @@ val to_pretty_string : t -> string val of_settings : unit -> t option Promise.t +val detect : unit -> t option Promise.t + +val of_settings_or_detect : unit -> t option Promise.t + val save_to_settings : t -> unit Promise.t (** [select_toolchain_and_save] requires the process environment the plugin is being run in diff --git a/src/vscode_ocaml_platform.ml b/src/vscode_ocaml_platform.ml index 07d0879c4..b77a645b2 100644 --- a/src/vscode_ocaml_platform.ml +++ b/src/vscode_ocaml_platform.ml @@ -19,11 +19,7 @@ let activate (extension : ExtensionContext.t) = because we use vscode [output] pane for logs *) Process.Env.set "OCAML_LSP_SERVER_LOG" "-"; let open Promise.Syntax in - let* toolchain = - Toolchain.of_settings () - (* TODO: implement [Toolchain.from_settings_or_detect] that would - either get the sandbox from the settings or detect in a smart way (not simply Global) *) - in + let* toolchain = Toolchain.of_settings_or_detect () in let is_fallback = Option.is_empty toolchain in let toolchain = Option.value toolchain ~default:Toolchain.Global in Extension_instance.make toolchain diff --git a/vscode-ocaml-platform.opam b/vscode-ocaml-platform.opam index 7a5abac2b..818bdd666 100644 --- a/vscode-ocaml-platform.opam +++ b/vscode-ocaml-platform.opam @@ -22,7 +22,7 @@ depends: [ "js_of_ocaml" {>= "3.7.0"} "gen_js_api" {>= "1.0.6"} "core_kernel" {>= "v0.14.0"} - "promise_jsoo" {>= "0.2.0"} + "promise_jsoo" {>= "0.3.0"} "jsonoo" {>= "0.2.0"} "odoc" {with-doc} ] diff --git a/vscode.opam b/vscode.opam index 707c59963..63e3c3dfc 100644 --- a/vscode.opam +++ b/vscode.opam @@ -20,7 +20,7 @@ depends: [ "ocaml" {>= "4.11"} "js_of_ocaml" {>= "3.7.0"} "gen_js_api" {>= "1.0.6"} - "promise_jsoo" {>= "0.2.0"} + "promise_jsoo" {>= "0.3.0"} "jsonoo" {>= "0.2.0"} "odoc" {with-doc} ]